home *** CD-ROM | disk | FTP | other *** search
/ Aminet 49 / Aminet 49 (2002)(GTI - Schatztruhe)[!][Jun 2002].iso / Aminet / util / boot / Bekuna.lha / bekuna1.5 / BEKUNA.rexx < prev    next >
OS/2 REXX Batch file  |  2002-03-24  |  59KB  |  2,239 lines
  1. /* BEGRÜßUNG-BEKUNA */
  2. /* Geschrieben von Kuno Naumann am 06.02.2002 */
  3. v='$VER: BEKUNA.rexx V1.5 (24.03.2002) von Kuno Naumann'
  4. vers=right(v,(length(v)-lastpos("V",v))+1)
  5.  
  6. /*--------Benutzer-Einstellung-----------*/
  7.  
  8. hilfean=1    /*Sprechblasenhilfe (1=An / 0=Aus)*/
  9. blaverz=2  /*Sprechblasenverzögerung (in ganzen Sekunden)*/
  10. bigro=30    /*Hintergrund-Bildausschnittgröße (in Bildpunkten)*/
  11. topaz=0     /*Vorgabe-FONT (0=Times & Courier / 1=Topaz/8)*/
  12.  
  13. /*---Nur Ändern bei Verwendung anderer Mondgrafiken---*/
  14.  
  15. brate=17    /*Anzahl der Mondbilder (Bilder pro Streifen)*/
  16. mogrb=40   /*Breite der einzelnen Mondbilder (in Bildpunkten)*/
  17. mogrh=40   /*Höhe der einzelnen Mondbilder (in Bildpunkten)*/
  18.  
  19. /*---------Ab hier nicht ändern!----------*/
  20.  
  21. zeizo=-1   /*Zeitzone*/
  22.  
  23. if 0 then say trace('results')
  24.  
  25. if show('P','BEKUNA') then do
  26.   address BEKUNA 'front'
  27.   exit
  28. end
  29.  
  30. signal on break_e
  31. signal on syntax
  32. signal on error
  33. signal on halt
  34. signal on ioerr
  35.  
  36. if ~show('L','rexxtricks.library') then
  37. if ~addlib('rexxtricks.library',0,-30,38) then exit
  38.  
  39. if ~show('L','rexxmathlib.library') then
  40. if ~addlib('rexxmathlib.library',0,-30,38) then exit
  41.  
  42. OPTIONS RESULTS
  43. ADDRESS COMMAND
  44.  
  45. call pragma('d','rexx:')
  46. call pragma("stack",8192)
  47.  
  48. /* Sommerzeit laden */
  49. s=0 ; som="Winterzeit"
  50. y=getenv('summertime')
  51. if y="" then do
  52. jn=frage("Haben wir jetzt Sommerzeit?")
  53. if jn=1 then y="YES"
  54. else y="NO"
  55. call open(1,'Envarc:summertime','W')
  56. call writeln(1,y)
  57. call close(1)
  58. call setenv('summertime',y)
  59. end
  60. if y='YES' then do
  61. s=1 ; som='Sommerzeit'
  62. end
  63.  
  64. call feiertage()
  65. call holedaten()
  66. call auswertung()
  67.  
  68. /*Mondphase*/
  69. prozm=mond(date('I'),time(),zeizo-s)
  70. parse var prozm mopha ri
  71. mop=round(mopha,0)
  72. if ri=1
  73. then zuab='Zunehmend'
  74. else zuab='Abnehmend'
  75. if mopha>98 then zuab='Vollmond'
  76. if mopha<2 then zuab='Neumond'
  77. mori=ri
  78.  
  79. /*Datum/Zeit*/
  80. dat=datumd('L')
  81. zei=time('N')
  82.  
  83. call bildegui()
  84.  
  85. soundgg=""
  86. if ont.1 then do
  87. call soundplay(tond.1)
  88. call pause(1)
  89. end
  90. tickz=0 ; cygz=1 ; cyez=1 ; cyfz=1
  91. call tonmeldung()
  92. textcyc=varicyc
  93. blv=0
  94.  
  95. do while ~eof(ca1)
  96. call topipe('tick 100')
  97. in=readln(ca1)
  98. parse var in in1 in2 in3 in4 .
  99. if blv>0 then do
  100. blv=blv-1
  101. if blv=0 then do
  102. bla=bln
  103. call topipe('bubble top 'bly' left 'blx' gt "'hilfe.bln'"')
  104. end
  105. end
  106. if in1='help' & hilfean=1 then call blase(in2)
  107. if in1='active' then call blase(0)
  108. if in1='gadget' then call objekt1()
  109. if in1='menu' then call menue()
  110. if in1='close' then call fensterzu()
  111. if in1='arexx' then call abefehl()
  112. if in1='tick' then call zeit()
  113. end
  114. call close(ca1)
  115. exit
  116.  
  117. /*--------- Objekt1 -----------*/
  118.  
  119. objekt1:
  120.  
  121. if gz>1 then
  122. if in2=gcgg then do
  123. cnr=in3+1
  124. call topipe('id 'gzgg' gt="'geb.cnr'"')
  125. textcyc=0
  126. end
  127.  
  128. if ez>1 then
  129. if in2=ecgg then do
  130. cnr=in3+1
  131. call topipe('id 'ezgg' gt="'ereig.cnr'"')
  132. textcyc=0
  133. end
  134.  
  135. if fz>1 then
  136. if in2=fcgg then do
  137. cnr=in3+1
  138. call topipe('id 'fzgg' gt="'feier.cnr'"')
  139. textcyc=0
  140. end
  141.  
  142. if in2=swkgg then call kalender(0,,,,hbf.5)
  143.  
  144. if in2=swegg then call eingabe(2) 
  145.  
  146. if in2=swfgg then do
  147. in1='menu'
  148. in2=1 ; in3=0
  149. end
  150.  
  151. if in2=swagg then do
  152. in1='menu'
  153. in2=1 ; in3=4
  154. end
  155.  
  156. return
  157.  
  158. /*--------- Menü -----------*/
  159.  
  160. menue:
  161. if in2=0 then do
  162. if in3=0 then call showtx(2000,"Info","Vorletzter Systemstart war am:*n"datumd('L',word(leda,1))" | "word(leda,2),1,hbf.4)
  163. if in3=1 then call einstell()
  164. if in3=2 then call fensterpos(1,1,1,2)
  165. if in3=3 then call fensterpos(1,0,1,0)
  166. if in3=5 then call showtx(2000,"Über","Begrüßungsprogramm*nBEKUNA.rexx*n"vers"*nEMail: *nkuno-n@freenet.de",1,hbf.4)
  167. if in3=6 then signal fensterzu
  168. end
  169.  
  170. if in2=1 then do
  171.  
  172. /*Feiertage dieses Jahr zeigen*/
  173.  
  174. if in3=0 then do
  175. call showtx(0,"Bitte Warten!","Feiertagsliste wird erstellt",0,hbf.4)
  176. jahr=left(date('S'),4)
  177. do i=1 to feierlist.0
  178. y=feierlist.i
  179. parse var y it "|" tx "|" fei
  180. select
  181. when fei=1 then fei=" Ja "
  182. when fei>1 then fei=" Ja - nicht überall"
  183. otherwise fei=" "
  184. end
  185. anzlist.i=datumd('W',it)"|"datumd('K',it)"|"tx"|"fei
  186. end
  187. anzlist.0=feierlist.0
  188. call listanz("Feier- und Gedenktage "jahr,"Wochentag|Datum|Ereignis|gesetzl. Feiertag","anzlist",winpos.5,in3,hbf.2)
  189. end
  190.  
  191. /*Feiertage nächstes Jahr zeigen*/
  192.  
  193. if in3=1 then do
  194. call showtx(0,"Bitte Warten!","Feiertagsliste wird erstellt",0,hbf.4)
  195. /*berechnen und speichern*/
  196. y=0
  197. xj=left(date('S'),4)+1
  198. if exists('Daten/FeiertageNJ') then do
  199. call open(3,'Daten/FeiertageNJ','R')
  200. y=readln(3)
  201. call close(3)
  202. end
  203. if y~=xj then do
  204. call open(3,'Daten/FeiertageNJ','W')
  205. call writeln(3,xj)
  206. call feiernj()
  207. end
  208. /*laden und sortieren*/
  209. call open(3,'Daten/FeiertageNJ','R')
  210. jahr=readln(3)
  211. do z=1
  212. y=readln(3)
  213. if eof(3) then leave
  214. feierlistnj.z=y
  215. end
  216. call close(3)
  217. feierlistnj.0=z-1
  218. call qsort('feierlistnj',,'NUM',1,'|')
  219. /*Datum ermitteln und anzeigen*/
  220. do i=1 to feierlistnj.0
  221. y=feierlistnj.i
  222. parse var y it "|" tx "|" fei
  223. select
  224. when fei=1 then fei=" Ja "
  225. when fei>1 then fei=" Ja - nicht überall"
  226. otherwise fei=" "
  227. end
  228. anzlist.i=datumd('W',it)"|"datumd('K',it)"|"tx"|"fei
  229. end
  230. anzlist.0=feierlistnj.0
  231. call listanz("Feier- und Gedenktage "jahr,"Wochentag|Datum|Ereignis|gesetzl. Feiertag","anzlist",winpos.6,in3,hbf.2)
  232. end
  233.  
  234. /*Geburtstage zeigen*/
  235.  
  236. if in3=2 then do
  237. z=0
  238. do i=1 to meli1.0
  239. parse var diffli1.i . '|' nr '|' .
  240. if nr<=mlg then do
  241. parse var meli1.nr tx'|'da
  242. parse var da t'.'m'.'j
  243. a=xj-j
  244. if date('I',xj||m||t,'S')>xi then a=a-1
  245. z=z+1
  246. anzlist.z=tx'|'wochentag(da) da'|'a'|'sternzeichen(t,m)
  247. end
  248. end
  249. anzlist.0=z
  250. call listanz("Geburtstage","Vorname|Geburtsdatum|Alter|Sternzeichen","anzlist",winpos.7,in3,hbf.2)
  251. end
  252.  
  253. /*verg. Ereignisse zeigen*/
  254.  
  255. if in3=3 then do
  256. z=0
  257. do i=1 to meli1.0
  258. parse var diffli1.i . '|' nr '|' .
  259. if nr>mlg then do
  260. parse var meli1.nr tx'|'da
  261. z=z+1
  262. anzlist.z=tx'|'wochentag(da) da
  263. end
  264. end
  265. anzlist.0=z
  266. call listanz("vergangene Ereignisse","Ereignis|Datum","anzlist",winpos.8,in3,hbf.2)
  267. end
  268.  
  269. /*komm. Ereignisse zeigen*/
  270.  
  271. if in3=4 then do
  272. do i=1 to meli3.0
  273. parse var diffli2.i . '|' nr '|' .
  274. parse var meli3.nr tx'|'da
  275. parse var da t'.'m'.'j
  276. dd=tx'|'datumd('M',t,m,j)
  277. if symbol('lzle.nr')="VAR" then anzlist.i="X|"dd
  278. else anzlist.i=" |"dd
  279. end
  280. anzlist.0=i-1
  281. call listanz("kommende Ereignisse","Abg.|Ereignis|Datum","anzlist",winpos.9,in3,hbf.2)
  282. end
  283.  
  284. /*wiederk. Ereignisse zeigen*/
  285.  
  286. if in3=5 then do
  287. do i=1 to meli4.0
  288. parse var meli4.i tx'|'da'|'da2'|'inn
  289. parse var da t'.'m'.'j
  290. da=datumd('M',t,m,j)
  291. if length(da2)=10 then do
  292. parse var da2 t'.'m'.'j
  293. da2=datumd('M',t,m,j)
  294. end
  295. if inn=0 then tinn="Ausgeschaltet"
  296. if inn>0 & inn<6 then tinn="Jeder "inn+1". Tag"
  297. if inn=6 then tinn="Jede Woche"
  298. if inn>6 & inn<10 then tinn="Jede "inn-5". Woche"
  299. if inn=10 then tinn="Jeden Monat"
  300. if inn>10 & inn<13 then tinn="Jeder "inn-9". Monat"
  301. if inn=13 then tinn="Jeder 6. Monat"
  302. if inn=14 then tinn="Jedes Jahr"
  303. anzlist.i=tx'|'da'|'da2'|'tinn
  304. end
  305. anzlist.0=i-1
  306. call listanz("wiederkehrende Ereignisse","Ereignis|Ab Datum|Bis Datum|Intervall","anzlist",winpos.12,7,hbf.2)
  307. end
  308.  
  309. end
  310.  
  311. /*Eingabe*/
  312.  
  313. if in2=2 then call eingabe(in3)
  314.  
  315. return
  316.  
  317. /*------- Zeit --------*/
  318.  
  319. zeit:
  320. zei=time('N')
  321. call topipe('id 'zeigg' gt "'zei' Uhr"')
  322. if textcyc~=1 then return
  323. tickz=tickz+1
  324. if tickz=3 then tickz=0
  325.  
  326. if gz>1 & tickz=0 then do
  327. cygz=cygz+1
  328. if cygz>gz then cygz=1
  329. call topipe('id 'gcgg' s='cygz-1)
  330. call topipe('id 'gzgg' gt="'geb.cygz'"')
  331. if variton then do
  332. if symbol('tmeld.1')='VAR' & grug.cygz=0 & ont.3 then call soundplay(tond.3)
  333. if symbol('tmeld.2')='VAR' & grug.cygz=1 & ont.4 then call soundplay(tond.4)
  334. if symbol('tmeld.3')='VAR' & grug.cygz=2 & ont.5 then call soundplay(tond.5)
  335. end
  336. end
  337.  
  338. if ez>1 & tickz=1 then do
  339. cyez=cyez+1
  340. if cyez>ez then cyez=1
  341. call topipe('id 'ecgg' s='cyez-1)
  342. call topipe('id 'ezgg' gt="'ereig.cyez'"')
  343. if variton then do
  344. if symbol('tmeld.4')='VAR' & ont.6 then call soundplay(tond.6)
  345. end
  346. end
  347.  
  348. if fz>1 & tickz=2 then do
  349. cyfz=cyfz+1
  350. if cyfz>fz then cyfz=1
  351. call topipe('id 'fcgg' s='cyfz-1)
  352. call topipe('id 'fzgg' gt="'feier.cyfz'"')
  353. if variton then do
  354. if symbol('tmeld.5')='VAR' & gruf.cyfz=0 & ont.7 then call soundplay(tond.7)
  355. if symbol('tmeld.6')='VAR' & gruf.cyfz=1 & ont.8 then call soundplay(tond.8)
  356. end
  357.  
  358. end
  359. return
  360.  
  361. /*-------- Arexxbefehl ---------*/
  362.  
  363. abefehl:
  364. rxcmd=readch(ca1,in3)
  365. if in2>1 then call topipe("rc 10")
  366. /*Befehl-front*/
  367. if in2=0 then do
  368. call topipe('rc 0 result "Fenster nach vorn geholt"')
  369. call topipe('id 0 s 67')
  370. end
  371. /*Befehl-quit*/
  372. if in2=1 then do
  373. call topipe('rc 0 result "Bekuna beendet"')
  374. signal fensterzu
  375. end
  376. return
  377.  
  378. /*-------- Schließen ---------*/
  379.  
  380. fensterzu:
  381. if ont.2 then do
  382. call soundplay(tond.2)
  383. call pause(1)
  384. end
  385. call close(ca1)
  386. call programm()
  387. call remlib('rexxmathlib.library')
  388. call remlib('rexxtricks.library')
  389. exit
  390. return
  391.  
  392. /* ************** UNTERPROGRAMME ***************** */
  393.  
  394. holedaten:
  395. /*-----Vorgaben-----*/
  396. varicyc=1 ; variton=1 ; ablo=1 ; mogra=1 ; progs=0
  397. gv=14 ; vv=9 ; kv=8 ; fv=8 ; dv=5 ; froh=1
  398. do i=1 to 8
  399. ont.i=0 ; tond.i=""
  400. if i<8 then do
  401. onp.i=0 ; prod.i=""
  402. end
  403. if i<7 then do
  404. tmv.i=0 ; pmv.i=0
  405. end
  406. end
  407. hgd.0=5 ; std.0=5 ; zsb.0=6
  408. tmv.0=6 ; ont.0=8 ; tond.0=8
  409. pmv.0=6 ; onp.0=7 ; prod.0=7
  410. keine="Zur Zeit sind keine Ereignisse."
  411. keined="Es sind keine Daten vorhanden."
  412. hgpfad="Sys:Prefs/Presets/Patterns/Einfarbig/"
  413. wa="gelb grün hellblau orange hellrot"
  414. wb="1 0 0 0 0"
  415. if topaz then
  416. do i=1 to 6
  417. zsb.i='gt="topaz.font" defn=8 s=0'
  418. end
  419. else do
  420. zsb.1='gt="times.font" defn=18 s=0'
  421. zsb.2='gt="times.font" defn=18 s=0'
  422. zsb.3='gt="times.font" defn=15 s=0'
  423. zsb.4='gt="times.font" defn=18 s=0'
  424. zsb.5='gt="courier.font" defn=13 s=0'
  425. zsb.6='gt="courier.font" defn=13 s=0'
  426. end
  427. mogdz="Rexx:Daten/MondanimZ"
  428. mogda="Rexx:Daten/MondanimA"
  429. vorgx="0 1 2 3 4 5 6 7 14 21 30 61 91 183 365"
  430. vorgt="0 -1 1 2 3 4 5 6 7 14 21 30"
  431. vorgp="0 1 2 3 4 5 6 7 8 9 10 11 12 13 14"
  432. /*-----Einstellungen laden-----*/
  433. if open(9,'Daten/Einstellungen','R') then do
  434. do i=1 to hgd.0
  435. hgd.i=readln(9)
  436. std.i=readln(9)
  437. if ~exists(hgd.i) then std.i=1
  438. if std.i then hbf.i=""
  439. else hbf.i='bf="'hgd.i'"'
  440. end
  441. do i=1 to 2
  442. y=readln(9)
  443. end
  444. if eof(9) then break
  445. do i=1 to zsb.0
  446. y=readln(9)
  447. if index(y,'.font')>0 then zsb.i=y
  448. end
  449. if eof(9) then break
  450. do i=1 to 2
  451. y=readln(9)
  452. end
  453. if eof(9) then break
  454. do i=1 to ont.0
  455. y=readln(9)
  456. parse var y ont.i" "tond.i
  457. if ~exists(tond.i) then ont.i=0
  458. end
  459. do i=1 to 2
  460. y=readln(9)
  461. end
  462. do i=1 to onp.0
  463. y=readln(9)
  464. parse var y onp.i" "prod.i
  465. if ~exists(prod.i) then onp.i=0
  466. end
  467. do i=1 to 3
  468. y=readln(9)
  469. end
  470. y=readln(9)
  471. if words(y)=5 then
  472. parse var y gv vv kv fv dv .
  473. y=readln(9)
  474. if words(y)=tmv.0 then
  475. do i=1 to tmv.0
  476. tmv.i=word(y,i)
  477. end
  478. y=readln(9)
  479. if words(y)=pmv.0 then
  480. do i=1 to pmv.0
  481. pmv.i=word(y,i)
  482. end
  483. progs=readln(9)
  484. ablo=readln(9)
  485. varicyc=readln(9)
  486. toncyc=readln(9)
  487. mogra=readln(9)
  488. call close(9)
  489. end
  490.  
  491. else
  492. do i=1 to hgd.0
  493. hgd.i=hgpfad||word(wa,i)
  494. std.i=word(wb,i)
  495. if ~exists(hgd.i) then std.i=1
  496. if std.i then hbf.i=""
  497. else hbf.i='bf="'hgd.i'"'
  498. end
  499.  
  500. gvor=word(vorgx,gv+1)
  501. vvor=word(vorgx,vv+1)
  502. kvor=word(vorgx,kv+1)
  503. fvor=word(vorgx,fv+1)
  504. dvor=word(vorgx,dv+1)
  505. do i=1 to tmv.0
  506. tvor.i=word(vorgt,tmv.i+1)
  507. end
  508. do i=1 to pmv.0
  509. pvor.i=word(vorgp,pmv.i+1)
  510. end
  511. if tvor.1<0 then tvor.1=gvor
  512. if tvor.2<0 then tvor.2=gvor
  513. if tvor.3<0 then tvor.3=vvor
  514. if tvor.4<0 then tvor.4=kvor
  515. if tvor.5<0 then tvor.5=fvor
  516. if tvor.6<0 then tvor.6=dvor
  517.  
  518. /*Letzte Nutzung laden*/
  519. leda=getenv('lastboot')
  520. if length(leda)=0 then do
  521. leda=date('I') time()
  522. call setenv('lastboot',leda)
  523. end
  524. call open(8,'envarc:lastboot','W')
  525. call writeln(8,date('I') time())
  526. call close(8)
  527.  
  528. /*Fensterposition laden*/
  529. winpos.0=12
  530. do i=1 to 12
  531. winpos.i="cs"
  532. end
  533. if readfile('daten/Fpos','winpos') then
  534. do i=1 to winpos.0
  535. parse var winpos.i lp tp wp hp op
  536. select
  537. when op=0 then winpos.i='cs width='wp 'height='hp
  538. when op=1 then winpos.i='left='lp 'top='tp 'width='wp 'height='hp
  539. when op=2 then winpos.i='left='lp 'top='tp
  540. otherwise winpos.i='cs'
  541. end
  542. end
  543. call ladedaten()
  544. /*-----Feiertage laden-----*/
  545. call open(3,'Daten/Feiertage','R')
  546. jahr=readln(3)
  547. do z=1
  548. y=readln(3)
  549. if eof(3) then leave
  550. feierlist.z=y
  551. end
  552. call close(3)
  553. feierlist.0=z-1
  554. call qsort('feierlist',,'NUM',1,'|')
  555. return
  556.  
  557. /*-----Geburtstage laden-----*/
  558. ladedaten:
  559. if ~open(2,'Daten/Gebdaten','R') then do
  560. ename="User"
  561. meli1.0=0
  562. mlg=0
  563. end
  564. else do
  565. do z=1
  566. y=readln(2)
  567. if eof(2) then leave
  568. if z=1 then parse var y ename "|" .
  569. meli1.z=y
  570. end
  571. call close(2)
  572. mlg=z-1
  573. end
  574. /*-----Ereignisse laden-----*/
  575. parse value datumd('D') with xt xm xj . xi
  576. if ~ readfile('Daten/Ereignisdaten1','meli2') then meli2.0=0
  577. if meli2.0>0 then
  578. do i=1 to meli2.0
  579. z=mlg+i
  580. meli1.z=meli2.i
  581. end
  582. meli1.0=mlg+meli2.0
  583. if ~ readfile('Daten/Ereignisdaten3','meli4') then meli4.0=0
  584. call wiederaus()
  585. if ~ readfile('Daten/Ereignisdaten2','meli3') then meli3.0=0
  586. return
  587.  
  588. /*------------AUSWERTUNG--------------*/
  589.  
  590. auswertung:
  591. /*-----Begrüßungstext-----*/
  592. st=left(time('N'),2)
  593. if st>=0 & st<=2 then beg=ename", was machst du so spät noch mit mir? Geh' lieber ins Bett !!!"
  594. if st>2 & st<=4 then beg=ename", so früh am Computer?  Geh' lieber ins Bett!"
  595. if st>4 & st<=6 then beg="Guten Morgen," ename"!  Schon so früh auf?"
  596. if st>6 & st<=10 then beg="Guten Morgen," ename"!  Viel Spaß mit mir!"
  597. if st>10 & st<=17 then beg="Guten Tag," ename"!  Viel Spaß mit mir!"
  598. if st>17 & st<=21 then beg="Guten Abend," ename"!  Viel Spaß mit mir!"
  599. if st>21 & st<24 then beg="Gute Nacht," ename"!  Jetzt aber ab ins Bett!"
  600. if st>=0 & st<5 then froh=0
  601. /*-----Aktuelles Sternzeichen-----*/
  602. stern=sternzeichen(xt,xm)
  603. /*-----Begrüßungstext2-----*/
  604. ledd=xi-word(leda,1)
  605. if ledd>1 then do
  606. froh=0
  607. beg1="Du hast mich schon "ledd" Tage nicht mehr eingeschaltet!"
  608. beg2=ename", Du vernachlässigst mich!"
  609. if ledd>5 then beg2=ename", meine Platinen rosten!"
  610. if ledd>10 then beg2=ename", hast Du etwa eine andere Freundin?"
  611. end
  612. /*-----Nächster Geburtstag oder verg. Ereignis-----*/
  613. zd=0
  614. do i=1 to meli1.0
  615. parse var meli1.i n '|' t '.' m '.' j
  616. dd=date('I',xj||m||t,'S')
  617. diffli1.i=dd-xi'|'i'|'n'|'xj-j
  618. end
  619. z=meli1.0
  620. do i=1 to meli1.0
  621. parse var meli1.i n '|' t '.' m '.' j
  622. dd=date('I',xj+1||m||t,'S')
  623. zd=z+i
  624. diffli1.zd=dd-xi'|'i'|'n'|'xj+1-j
  625. end
  626. diffli1.0=zd
  627. call qsort('diffli1',,'NUM',1,'|')
  628. gz=0
  629. do i=1 to diffli1.0
  630. parse var diffli1.i dft '|' dfi '|' dfn '|' dfa
  631. if dft>=0 then do
  632. if dft<=tvor.1 & dfi=1 then tmeld.1=1
  633. if dft<=tvor.2 & dfi>1 then tmeld.2=1
  634. if dft<=tvor.3 & dfi>mlg then tmeld.3=1
  635. if dft<=pvor.1 & dfi=1 then pmeld.1=1
  636. if dft<=pvor.2 & dfi>1 then pmeld.2=1
  637. if dft<=pvor.3 & dfi>mlg then pmeld.3=1
  638. end
  639. if dft>=0 & dft<=gvor then do
  640. mwt=left(datumd('W',xi+dft),2)
  641. if dfi=1 then do
  642. gz=gz+1
  643. grug.gz=0
  644. if dft>1 then geb.gz=ename", in" dft "Tagen ("mwt") ist Dein" dfa". Geburtstag!"
  645. if dft=1 then geb.gz=">>>" ename", Morgen ist Dein" dfa". Geburtstag! <<<"
  646. if dft=0 then geb.gz=">>>" ename", Heute ist Dein" dfa". Geburtstag! <<<"
  647. end
  648. if dfi>1 & dfi<=mlg then do
  649. gz=gz+1
  650. grug.gz=1
  651. if dft>1 then geb.gz="In" dft "Tagen ("mwt") ist der" dfa". Geburtstag von" dfn"!"
  652. if dft=1 then geb.gz=">>> Morgen ist der" dfa". Geburtstag von" dfn"! <<<"
  653. if dft=0 then geb.gz=">>> Heute ist der" dfa". Geburtstag von" dfn"! <<<"
  654. end
  655. end
  656. if dft>=0 & dft<=vvor then do
  657. mwt=left(datumd('W',xi+dft),2)
  658. if dfi>mlg then do
  659. gz=gz+1
  660. grug.gz=2
  661. if dft>1 then geb.gz=ename", in" dft "Tagen ("mwt") ist Dein" dfa"." dfn"!"
  662. if dft=1 then geb.gz=">>>" ename", Morgen ist Dein" dfa"." dfn"! <<<"
  663. if dft=0 then geb.gz=">>>" ename", Heute ist Dein" dfa"." dfn"! <<<"
  664. end
  665. end
  666. end
  667. /*-----kommendes Ereignis-----*/
  668. do i=1 to meli3.0
  669. parse var meli3.i n '|' t '.' m '.' j
  670. dd=date('I',j||m||t,'S')
  671. dta=dd-xi
  672. if ablo & dta<0 then lzle.i=i
  673. diffli2.i=dta'|'i'|'n
  674. end
  675. diffli2.0=meli3.0
  676. call qsort('diffli2',,'NUM',1,'|')
  677. ez=0
  678. do i=1 to diffli2.0
  679. parse var diffli2.i dft '|' . '|' dfn
  680. if dft>=0 & dft<=tvor.4 then tmeld.4=1
  681. if dft>=0 & dft<=pvor.4 then pmeld.4=1
  682. if dft>=0 & dft<=kvor then do
  683. mwt=left(datumd('W',xi+dft),2)
  684. ez=ez+1
  685. if dft>1 then ereig.ez="In" dft "Tagen ("mwt") ist "dfn"!"
  686. if dft=1 then ereig.ez=">>> Morgen ist "dfn"! <<<"
  687. if dft=0 then ereig.ez=">>> Heute ist "dfn"! <<<"
  688. end
  689. end
  690. /*-----Feiertage-----*/
  691. fz=0
  692. do i=1 to feierlist.0
  693. y=feierlist.i
  694. parse var y dd"|"tx"|"fei
  695. if tx="Sommerzeitanfang" then sza=dd
  696. if tx="Winterzeitanfang" then wza=dd
  697. dft=dd-xi
  698. if dft>=0 & dft<=tvor.5 & fei>0 then tmeld.5=1
  699. if dft>=0 & dft<=pvor.5 & fei>0 then pmeld.5=1
  700. if dft>=0 & dft<=fvor & fei>0 then do
  701. mwt=left(datumd('W',xi+dft),2)
  702. fz=fz+1
  703. gruf.fz=0
  704. if dft>1 then feier.fz="In" dft "Tagen ("mwt") ist "tx"."
  705. if dft=1 then feier.fz="Morgen ist "tx"."
  706. if dft=0 then feier.fz="Heute ist "tx"."
  707. feier.fz=feier.fz" «Gesetzlicher Feiertag!»"
  708. if fei>1 then feier.fz=feier.fz" «Feiertag! (Nicht in allen Gebieten!)»"
  709. if dft=0 then call kommentare()
  710. end
  711. if dft>=0 & dft<=tvor.6 & fei=0 then tmeld.6=1
  712. if dft>=0 & dft<=pvor.6 & fei=0 then pmeld.6=1
  713. if dft>=0 & dft<=dvor & fei=0 then do
  714. mwt=left(datumd('W',xi+dft),2)
  715. fz=fz+1
  716. gruf.fz=1
  717. if dft>1 then feier.fz="In" dft "Tagen ("mwt") ist "tx"."
  718. if dft=1 then feier.fz="Morgen ist "tx"."
  719. if dft=0 then feier.fz="Heute ist "tx"."
  720. if dft=0 then call kommentare()
  721. end
  722. end
  723. /*-----Sommerzeitumstellung-----*/
  724. if (xi>=sza & xi<wza) & s=0 then do
  725. call open(1,'envarc:summertime','W')
  726. call writeln(1,"YES")
  727. call close(1)
  728. call setenv('summertime','YES')
  729. s=1 ; som='Sommerzeit'
  730. ns=left(time('N'),2)
  731. ns=ns+1
  732. if ns>23 then ns=0
  733. ns=right('0'||ns,2)
  734. DATE overlay(ns,time('N'))
  735. if ns=0 then DATE morgen
  736. SetClock SAVE
  737. meld4=ename", ich habe meine Uhr auf Sommerzeit umgestellt."
  738. tmeld.7=1
  739. end
  740. /*-----Winterzeitumstellung-----*/
  741. if (xi<sza | xi>=wza) & s=1 then do
  742. call open(1,'envarc:summertime','W')
  743. call writeln(1,"NO")
  744. call close(1)
  745. call setenv('summertime','NO')
  746. s=0 ; som="Winterzeit"
  747. ns=left(time('N'),2)
  748. ns=ns-1
  749. if ns<0 then ns=23
  750. ns=right('0'||ns,2)
  751. DATE overlay(ns,time('N'))
  752. if ns=23 then DATE gestern
  753. SetClock SAVE
  754. meld4=ename", ich habe meine Uhr auf Winterzeit umgestellt."
  755. tmeld.7=1
  756. end
  757. return
  758.  
  759. /*==========Feiertagsliste erstellen==========*/
  760. /*(nur zu Beginn eines neuen Jahres)*/
  761. feiertage:
  762. xj=left(date('S'),4)
  763. if ~exists('Daten') then do
  764. call showtx(1500,"Fehler!","Das Verzeichnis «REXX:Daten» existiert nicht!",1,hbf.4)
  765. exit
  766. end
  767. if exists('Daten/Feiertage') then do
  768. call open(3,'Daten/Feiertage','R')
  769. y=readln(3)
  770. call close(3)
  771. if y=xj then return
  772. end
  773. call open(3,'Daten/Feiertage','W')
  774. call writeln(3,xj)
  775. feiernj:
  776. /*-----Mondabhängige Feiertage-----*/
  777. b=date('I',xj||0319,'S')
  778. zu=0 ; a=0
  779. do until a
  780. b=b+1
  781. prozm=mond(b,'12:00:00',zeizo-s)
  782. parse var prozm mopha ri
  783. if ri=1 then zu=1
  784. if ri=0 & zu=1 then a=1
  785. end
  786. wn=word(datumd('D',b),4)
  787. a=b+(7-wn)
  788. if a=b then a=a+7
  789. call writeln(3,a-48"|Rosenmontag|"0)
  790. call writeln(3,a-47"|Fastnacht|"0)
  791. call writeln(3,a-46"|Aschermittwoch|"0)
  792. call writeln(3,a-7"|Palmsonntag|"0)
  793. call writeln(3,a-3"|Gründonnerstag|"0)
  794. call writeln(3,a-2"|Karfreitag|"1)
  795. call writeln(3,a"|Ostersonntag|"1)
  796. call writeln(3,a+1"|Ostermontag|"1)
  797. call writeln(3,a+7"|Weißer Sonntag|"0)
  798. call writeln(3,a+39"|Christi Himmelfahrt|"1)
  799. call writeln(3,a+49"|Pfingstsonntag|"1)
  800. call writeln(3,a+50"|Pfingstmontag|"1)
  801. call writeln(3,a+56"|Dreifaltigkeitsfest|"0)
  802. call writeln(3,a+60"|Fronleichnam|"2)
  803. /*-----Wochentagabhängige Feiertage-----*/
  804. b=a+49
  805. dw=datumd('D',01,05,xj)
  806. parse var dw . . . wn a
  807. a=a+(7-wn)
  808. if a+7~=b then a=a+7
  809. call writeln(3,a"|Muttertag|"0)
  810. dw=datumd('D',30,09,xj)
  811. parse var dw . . . wn a
  812. ma=a+(7-wn)
  813. dw=datumd('D',01,10,xj)
  814. parse var dw . . . wn a
  815. a=a+(7-wn)
  816. if ma=a then call writeln(3,a"|Erntedanktag|"0)
  817. else do
  818. call writeln(3,ma"|ev. Erntedanktag|"0)
  819. call writeln(3,a"|kath. Erntedanktag|"0)
  820. end
  821. dw=datumd('D',31,03,xj)
  822. parse var dw . . . wn a
  823. if wn<7 then a=a-wn
  824. call writeln(3,a"|Sommerzeitanfang|"0)
  825. dw=datumd('D',31,10,xj)
  826. parse var dw . . . wn a
  827. if wn<7 then a=a-wn
  828. call writeln(3,a"|Winterzeitanfang|"0)
  829. dw=datumd('D',24,12,xj)
  830. parse var dw . . . wn a
  831. if wn<7 then a=a-wn
  832. call writeln(3,a-35"|Volkstrauertag|"0)
  833. call writeln(3,a-32"|Buß- und Bettag|"2)
  834. call writeln(3,a-28"|Totensonntag|"0)
  835. call writeln(3,a-21"|1. Advent|"0)
  836. call writeln(3,a-14"|2. Advent|"0)
  837. call writeln(3,a-7"|3. Advent|"0)
  838. call writeln(3,a"|4. Advent|"0)
  839. /*-----Feste Feiertage-----*/
  840. call writeln(3,date('I',xj||0101,'S')"|Neujahr|"1)
  841. call writeln(3,date('I',xj||0106,'S')"|Heilige Drei Könige|"2)
  842. call writeln(3,date('I',xj||0202,'S')"|Mariä Lichtmeß|"0)
  843. call writeln(3,date('I',xj||0214,'S')"|Valentinstag|"0)
  844. call writeln(3,date('I',xj||0308,'S')"|Frauentag|"0)
  845. call writeln(3,date('I',xj||0325,'S')"|Mariä Verkündung|"0)
  846. call writeln(3,date('I',xj||0401,'S')"|1. April|"0)
  847. call writeln(3,date('I',xj||0430,'S')"|Walpurgisnacht|"0)
  848. call writeln(3,date('I',xj||0501,'S')"|Tag der Arbeit|"1)
  849. call writeln(3,date('I',xj||0505,'S')"|Europatag|"0)
  850. call writeln(3,date('I',xj||0511,'S')"|Beginn der Eisheiligen|"0)
  851. call writeln(3,date('I',xj||0515,'S')"|Tag der Familie|"0)
  852. call writeln(3,date('I',xj||0531,'S')"|Mariä Heimsuchung|"0)
  853. call writeln(3,date('I',xj||0621,'S')"|Sommersonnenwende|"0)
  854. call writeln(3,date('I',xj||0627,'S')"|Siebenschläfer|"0)
  855. call writeln(3,date('I',xj||0723,'S')"|Beginn der Hundstage|"0)
  856. call writeln(3,date('I',xj||0808,'S')"|Friedensfest|"0)
  857. call writeln(3,date('I',xj||0815,'S')"|Mariä Himmelfahrt|"2)
  858. call writeln(3,date('I',xj||0920,'S')"|Weltkindertag|"0)
  859. call writeln(3,date('I',xj||0929,'S')"|Michaelistag|"0)
  860. call writeln(3,date('I',xj||1003,'S')"|Tag der deutschen Einheit|"1)
  861. call writeln(3,date('I',xj||1031,'S')"|Reformationstag|"2)
  862. call writeln(3,date('I',xj||1031,'S')"|Halloween|"0)
  863. call writeln(3,date('I',xj||1101,'S')"|Allerheiligen|"2)
  864. call writeln(3,date('I',xj||1102,'S')"|Allerseelen|"0)
  865. call writeln(3,date('I',xj||1111,'S')"|Martinstag|"0)
  866. call writeln(3,date('I',xj||1206,'S')"|Nikolaus|"0)
  867. call writeln(3,date('I',xj||1208,'S')"|Mariä Empfängnis|"0)
  868. call writeln(3,date('I',xj||1221,'S')"|Wintersonnenwende|"0)
  869. call writeln(3,date('I',xj||1224,'S')"|Heiliger Abend|"0)
  870. call writeln(3,date('I',xj||1225,'S')"|1. Weihnachtstag|"1)
  871. call writeln(3,date('I',xj||1226,'S')"|2. Weihnachtstag|"1)
  872. call writeln(3,date('I',xj||1231,'S')"|Silvester|"0)
  873. call close(3)
  874. return
  875.  
  876. /*=====Kommentare=====*/
  877.  
  878. kommentare:
  879. if tx="Neujahr" then meld2=ename", ich wünsche Dir ein frohes und gesundes neues Jahr."
  880. if tx="Valentinstag" then meld2=ename", schenkst Du mir auch was?"
  881. if tx="Rosenmontag" then meld1=ename", ich wünsche Dir eine schöne Faschingsfeier."
  882. if tx="Fastnacht" then meld1=ename", ich wünsche Dir eine schöne Faschingsfeier."
  883. if tx="Ostersonntag" then meld1="Frohe Ostern" ename"!"
  884. if tx="Ostermontag" then meld1="Frohe Ostern" ename"!"
  885. if tx="1. April" then meld2=ename", ich lösche jetzt Deine Festplatte!"
  886. if tx="1. April" then meld3="APRIL, APRIL!!!"
  887. if tx="Christi Himmelfahrt" then meld1=ename", ich wünsche Dir alles Gute zum Vatertag. Trink nicht zu viel!"
  888. if tx="Tag der Arbeit" then meld2=ename", ich wünsche Dir einen schönen Maifeiertag."
  889. if tx="Heiliger Abend" then meld2="Frohe Weihnachten" ename"!"
  890. if tx="1. Weihnachtstag" then meld2=ename", ich wünsche Dir am 1. Weihnachtsfeiertag viel Spaß mit mir!"
  891. if tx="2. Weihnachtstag" then meld2=ename", ich wünsche Dir am 2. Weihnachtsfeiertag viel Spaß mit mir!"
  892. if tx="Silvester" then meld2=ename", ich wünsche Dir eine fröhliche Silvester-Party!"
  893. return
  894.  
  895. /*Fensterposition speichern*/
  896.  
  897. fensterpos:
  898. if ~ readfile('daten/Fpos','winpos') then
  899. do i=1 to 12
  900. winpos.i="-"
  901. end
  902. y=arg(1)
  903. if arg(3) then y2=topipeo('id 0 read')
  904. else y2=topipe2o('id 0 read')
  905. if arg(2) then winpos.y=y2 arg(4)
  906. else winpos.y="-"
  907. winpos.0=12
  908. call writefile('daten/Fpos','winpos')
  909. do i=2 to winpos.0
  910. if winpos.i="-" then winpos.i="cs"
  911. else do
  912. parse var winpos.i lp tp wp hp op
  913. if op=0 then winpos.i='cs width='wp 'height='hp
  914. if op=1 then winpos.i='left='lp 'top='tp 'width='wp 'height='hp
  915. if op=2 then winpos.i='left='lp 'top='tp
  916. end
  917. end
  918. return
  919.  
  920. /*=====================Eingabe===================*/
  921.  
  922. eingabe:
  923. aw=arg(1)
  924. drop kalgg kal2gg da2gg intgg
  925. if aw=0 then call bildegui2("Geburtstage","Vorname|Geburtsdatum","meli1",mlg,2)
  926. if aw=1 then call bildegui2("Vergangene Ereignisse","Ereignis|Datum","meli2",meli2.0,3)
  927. if aw=2 then call bildegui2("Kommende Ereignisse","Ereignis|Datum","meli3",meli3.0,4)
  928. if aw=3 then call bildegui2("Wiederkehrende Ereignisse","Ereignis|Ab Datum|Bis Datum|Intervall","meli4",meli4.0,11)
  929. linr=0
  930. do while ~eof(ca2)
  931. call topipe2('continue')
  932. ein=readln(ca2)
  933. parse var ein ein1 ein2 ein3 ein4 ein5 .
  934. parse var ein . . ein6
  935. if ein1='gadget' then call objekt2()
  936. if ein1='menu' then call menue2()
  937. if ein1='close' then leave
  938. end
  939. call close(ca2)
  940. return
  941.  
  942. /*------------------OBJEKT2-----------------*/
  943.  
  944. objekt2:
  945.  
  946. /*Auswahl*/
  947. if ein2=bgg then do
  948. linr=ein5-me0
  949. liggnr=ein5
  950. call topipe2('id 'lgg' dis 0 ref')
  951. parse var li.linr tfeld"|"dfeld"|"d2feld"|"intnr
  952. call sperr(0)
  953. end
  954.  
  955. /*Hinzufügen*/
  956. if ein2=ngg then do
  957. linr=li.0+1
  958. liggnr=me0+linr
  959. call topipe2('id 'lgg' dis 1 ref')
  960. tfeld="" ; dfeld="" ; d2feld="" ; intnr=-6
  961. if aw>1 then dfeld=datumd('Z')
  962. call sperr(0)
  963. if aw=3 then li.linr=tfeld"|"dfeld"|"d2feld"|"intnr
  964. else li.linr=tfeld"|"dfeld
  965. call topipe2('id 'bgg' gt="'li.linr'" tar=-1 addn')
  966. call topipe2('id 'bgg' s='liggnr' scr='liggnr)
  967. li.0=linr
  968. call topipe2('id 'vngg' s=0 ref')
  969. end
  970.  
  971. /*Entfernen*/
  972. if ein2=lgg & linr>0 & linr<=li.0 then do
  973. tfeld="" ; dfeld="" ; d2feld=""
  974. call sperr(1)
  975. if li.0=1 then do
  976. li.0=0
  977. linr=0
  978. end
  979. if li.0>1 then call stemremove('li',linr,1)
  980. call topipe2('id 'bgg' list 0')
  981. call topipe2('id 'bgg' remn')
  982. do i=1 to li.0
  983. call topipe2('id 'bgg' gt="'li.i'" tar=-1 addn')
  984. end
  985. call topipe2('id 'bgg' list 1')
  986. end
  987.  
  988. /*Textfeld*/
  989. if ein2=vngg then do
  990. mtfeld=tfeld
  991. tfeld=strip(ein6)
  992. y=pruef(tfeld,0)
  993. if y=0 then do
  994. tfeld=upper(left(tfeld,1))||right(tfeld,length(tfeld)-1)
  995. call topipe2('id 'vngg' gt "'tfeld'" ref')
  996. if aw=3 then do
  997. if tfeld~=mtfeld then intnr=0-intnr
  998. li.linr=tfeld"|"dfeld"|"d2feld"|"intnr
  999. end
  1000. else li.linr=tfeld"|"dfeld
  1001. call topipe2('id 'liggnr' gt="'li.linr'" ')
  1002. call topipe2('id 'dagg' s=0 ref')
  1003. end
  1004. end
  1005.  
  1006. /*Datumfeld*/
  1007. if ein2=dagg then do
  1008. mdfeld=dfeld
  1009. dfeld=strip(ein6)
  1010. dfeld=pruef(dfeld,1)
  1011. if dfeld~=0 then do
  1012. if dfeld~=mdfeld then intnr=0-intnr
  1013. if aw=3 then li.linr=tfeld"|"dfeld"|"d2feld"|"intnr
  1014. else li.linr=tfeld"|"dfeld
  1015. call topipe2('id 'lgg' dis 1 ref')
  1016. call topipe2('id 'liggnr' gt="'li.linr'"')
  1017. call topipe2('id 'dagg' gt="'dfeld'"')
  1018. if aw=3 then call topipe2('id 'da2gg' s=0 ref')
  1019. end
  1020. end
  1021.  
  1022. /*Datumfeld2*/
  1023. if ein2=da2gg then do
  1024. md2feld=d2feld
  1025. d2feld=strip(ein6)
  1026. d2feld=pruef(d2feld,2)
  1027. if d2feld~=0 then do
  1028. if d2feld~=md2feld then intnr=0-intnr
  1029. if aw=3 then li.linr=tfeld"|"dfeld"|"d2feld"|"intnr
  1030. else li.linr=tfeld"|"dfeld
  1031. call topipe2('id 'lgg' dis 1 ref')
  1032. call topipe2('id 'liggnr' gt="'li.linr'"')
  1033. call topipe2('id 'da2gg' gt="'d2feld'"')
  1034. end
  1035. end
  1036.  
  1037. /*Kalender(K)*/
  1038. if ein2=kalgg then do
  1039. mdfeld=dfeld
  1040. if length(dfeld)<10 then dfeld=kalender(1,,ca2,dagg,hbf.5)
  1041. else dfeld=kalender(1,dfeld,ca2,dagg,hbf.5)
  1042. dfeld=pruef(dfeld,1)
  1043. if dfeld~=0 then do
  1044. if dfeld~=mdfeld then intnr=0-intnr
  1045. if aw=3 then li.linr=tfeld"|"dfeld"|"d2feld"|"intnr
  1046. else li.linr=tfeld"|"dfeld
  1047. call topipe2('id 'liggnr' gt="'li.linr'"')
  1048. end
  1049. end
  1050.  
  1051. /*Kalender(K)2*/
  1052. if ein2=kal2gg & aw=3 then do
  1053. md2feld=d2feld
  1054. if length(d2feld)<10 then d2feld=kalender(1,,ca2,da2gg,hbf.5)
  1055. else d2feld=kalender(1,d2feld,ca2,da2gg,hbf.5)
  1056. d2feld=pruef(d2feld,1)
  1057. if d2feld~=0 then do
  1058. if d2feld~=md2feld then intnr=0-intnr
  1059. li.linr=tfeld"|"dfeld"|"d2feld"|"intnr
  1060. call topipe2('id 'liggnr' gt="'li.linr'"')
  1061. end
  1062. end
  1063.  
  1064. /*Intervall*/
  1065. if ein2=intgg & aw=3 then do
  1066. intnr=0-ein3
  1067. li.linr=tfeld"|"dfeld"|"d2feld"|"intnr
  1068. call topipe2('id 'liggnr' gt="'li.linr'" ')
  1069. end
  1070.  
  1071. /*Speichern*/
  1072. if ein2=spgg then do
  1073. if aw=3 then
  1074. do i=1 to li.0
  1075. parse var li.i tfeld"|"dfeld"|"d2feld"|"intnr
  1076. if intnr<0 then do
  1077. if exists('daten/Ereignisdaten2') then call open(7,'daten/Ereignisdaten2','A')
  1078. else call open(7,'daten/Ereignisdaten2','W')
  1079. call writeln(7,tfeld"|"dfeld)
  1080. call close(7)
  1081. intnr=abs(intnr)
  1082. li.i=tfeld"|"dfeld"|"d2feld"|"intnr
  1083. end
  1084. end
  1085. if aw=0 then
  1086. if li.0>0 then call writefile('daten/Gebdaten','li')
  1087. else 'delete >nil: daten/Gebdaten'
  1088. if aw=1 then
  1089. if li.0>0 then call writefile('daten/Ereignisdaten1','li')
  1090. else 'delete >nil: daten/Ereignisdaten1'
  1091. if aw=2 then
  1092. if li.0>0 then call writefile('daten/Ereignisdaten2','li')
  1093. else 'delete >nil: daten/Ereignisdaten2'
  1094. if aw=3 then
  1095. if li.0>0 then call writefile('daten/Ereignisdaten3','li')
  1096. else 'delete >nil: daten/Ereignisdaten3'
  1097. textcyc=0 ; toncyc=0
  1098. call ladedaten()
  1099. call auswertung()
  1100. end
  1101. return
  1102.  
  1103. sperr:
  1104. u=arg(1)
  1105. call topipe2('id 'vngg' gt "'tfeld'" dis 'u' ref')
  1106. call topipe2('id 'dagg' gt "'dfeld'" dis 'u' ref')
  1107. if aw>=2 then call topipe2('id 'kalgg' dis 'u' ref')
  1108. if aw=3 then do
  1109. call topipe2('id 'da2gg' gt "'d2feld'" dis 'u' ref')
  1110. call topipe2('id 'kal2gg' dis 'u' ref')
  1111. call topipe2('id 'intgg' s 'abs(intnr)' dis 'u' ref')
  1112. end
  1113. return
  1114.  
  1115. pruef:
  1116. procedure expose aw xi hbf.4
  1117. pr=0 ; nd=0
  1118. if arg(2)=0 & length(arg(1))<2 then pr=1
  1119. if arg(2)=2 & length(arg(1))=0 then return ""
  1120. if arg(2)=1 then do
  1121. parse value arg(1) with t'.'m'.'j
  1122. t=right(0||t,2) ; m=right(0||m,2)
  1123. if (t<1 | t>31)|(m<1 | m>12)|(j<1900 | j>2100) then pr=2
  1124. if aw>=2 then if date('I',j||m||t,'S')<xi then pr=3
  1125. end
  1126. if pr=1 then call showtx(500,'FEHLER!','Falsche Texteingabe!',0,hbf.4)
  1127. if pr=2 then call showtx(1000,'FEHLER!','Falsche Datumseingabe!*nBeispiel: 01.03.1970 oder 1.3.1970',0,hbf.4)
  1128. if pr=3 then call showtx(500,'FEHLER!','Ungültiges Datum!',0,hbf.4)
  1129. if pr=0 then nd=t'.'m'.'j
  1130. if arg(2)=0 then nd=pr
  1131. return nd
  1132.  
  1133. /*--------- Menü2 -----------*/
  1134.  
  1135. menue2:
  1136. if ein2=0 then
  1137. select
  1138. when ein3=2 then call fensterpos(efpos,0,0,0)
  1139. when ein3=3 then ein1='close'
  1140. otherwise call fensterpos(efpos,1,0,ein3)
  1141. end
  1142. return
  1143.  
  1144. /*---Wiederkehr-Auswertung---*/
  1145.  
  1146. wiederaus:
  1147. do i=1 to meli4.0
  1148. parse var meli4.i tx'|'abda'|'bida'|'inn
  1149. parse var abda d1t'.'d1m'.'d1j
  1150. ei=date('I',d1j||d1m||d1t,'S')
  1151. if length(bida)=10 then do
  1152. parse var bida d2t'.'d2m'.'d2j
  1153. bi=date('I',d2j||d2m||d2t,'S')
  1154. end
  1155. else bi=99000
  1156. if (xi>ei & xi<=bi) & inn>0 then do
  1157. if inn<7 then ei=ei+inn+1
  1158. if inn>6 & inn<10 then ei=ei+(inn-5)*7
  1159. if inn>9 & inn<14 then do
  1160. if inn<13 then d1m=d1m+(inn-9)
  1161. else d1m=d1m+6
  1162. if d1m>12 then do
  1163. d1m=d1m-12 ; d1j=d1j+1
  1164. end
  1165. d1m=right(0||d1m,2)
  1166. ei=date('I',d1j||d1m||d1t,'S')
  1167. end
  1168. if inn=14 then do
  1169. d1j=d1j+1
  1170. ei=date('I',d1j||d1m||d1t,'S')
  1171. end
  1172. /*Eintragen*/
  1173. if ei<=bi then do
  1174. if exists('daten/Ereignisdaten2') then call open(7,'daten/Ereignisdaten2','A')
  1175. else call open(7,'daten/Ereignisdaten2','W')
  1176. call writeln(7,tx"|"datumd('Z',ei))
  1177. call close(7)
  1178. meli4.i=tx"|"datumd('Z',ei)"|"bida"|"inn
  1179. call writefile('daten/Ereignisdaten3','meli4')
  1180. end
  1181. end
  1182. end
  1183. return
  1184.  
  1185. /*==================Einstellungen===================*/
  1186.  
  1187. einstell:
  1188. call showtx(0,"Bitte Warten!","Einstellungsfenster wird erstellt!",0,hbf.4)
  1189. call bildegui3()
  1190. if show('P','SHOWTX') then address 'SHOWTX' 'quit'
  1191. covaricyc=varicyc ; cotoncyc=toncyc ; coablo=ablo ; comogra=mogra
  1192. coprogs=progs ; coexpl=expl ; coexpd=expd
  1193. coxmv.1=gv ; coxmv.2=vv ; coxmv.3=kv ; coxmv.4=fv ; coxmv.5=dv
  1194. y=stemcopy('hgd',1,'cohgd',1)
  1195. y=stemcopy('std',1,'costd',1)
  1196. y=stemcopy('zsb',1,'cozsb',1)
  1197. y=stemcopy('tmv',1,'cotmv',1)
  1198. y=stemcopy('pmv',1,'copmv',1)
  1199. y=stemcopy('ont',1,'coont',1)
  1200. y=stemcopy('onp',1,'coonp',1)
  1201. y=stemcopy('tond',1,'cotond',1)
  1202. y=stemcopy('prod',1,'coprod',1)
  1203. ivx=1 ; ivt=1 ; ivp=1 ; blv2=0
  1204. do while ~eof(ca2)
  1205. call topipe2('tick 100')
  1206. ein=readln(ca2)
  1207. parse var ein ein1 ein2 ein3 ein4 ein5 ein6 .
  1208. parse var ein . . . ein7
  1209. if blv2>0 then do
  1210. blv2=blv2-1
  1211. if blv2=0 then do
  1212. bla2=bln2
  1213. call topipe2('bubble top 'bly2' left 'blx2' gt "'hilfe2.bln2'"')
  1214. end
  1215. end
  1216. if ein1='help' & hilfean=1 then call blase2(ein2)
  1217. if ein1='active' then call blase2(0)
  1218. if ein1='gadget' then call objekt3()
  1219. if ein1='menu' then call menue3()
  1220. if ein1='close' then leave
  1221. end
  1222. call close(ca2)
  1223. return
  1224.  
  1225. /*--------OBJEKT3--------*/
  1226.  
  1227. objekt3:
  1228.  
  1229. /*Hintergrund*/
  1230.  
  1231. do i=1 to hgd.0
  1232. if ein2=hdgg.i then do
  1233. cohgd.i=strip(strip(ein7),'B','"')
  1234. call topipe2('define bitmap fn "'cohgd.i'" part="0|0|'bigro'|'bigro'|0|0|0"')
  1235. call topipe2('id 'hbgg.i' ni 0')
  1236. end
  1237. if ein2=hsgg.i then do
  1238. costd.i=ein3
  1239. call topipe2('id 'hdgg.i' ref dis='costd.i)
  1240. call topipe2('id 'hbgg.i' ref dis='costd.i)
  1241. end
  1242. end
  1243.  
  1244. /*Fonts*/
  1245.  
  1246. do i=1 to zsb.0
  1247. if ein2=zsgg.i then
  1248. if ein3=1 then cozsb.i='gt="'ein4'" defn='ein5' s='ein6
  1249. else cozsb.i=""
  1250. end
  1251.  
  1252. /*Sound*/
  1253.  
  1254. do i=1 to ont.0
  1255. if ein2=ontgg.i then do
  1256. coont.i=ein3
  1257. u=~ein3
  1258. call topipe2('id 'sougg.i' ref dis='u)
  1259. call topipe2('id 'testtgg.i' ref dis='u)
  1260. end
  1261. if ein2=sougg.i then cotond.i=strip(strip(ein7),'B','"')
  1262. if ein2=testtgg.i then
  1263. if exists(cotond.i) then call soundplay(cotond.i)
  1264. end
  1265.  
  1266. /*Progstart*/
  1267.  
  1268. do i=1 to onp.0
  1269. if ein2=onpgg.i then do
  1270. coonp.i=ein3
  1271. u=~ein3
  1272. call topipe2('id 'startgg.i' ref dis='u)
  1273. call topipe2('id 'testpgg.i' ref dis='u)
  1274. end
  1275. if ein2=startgg.i then coprod.i=strip(strip(ein7),'B','"')
  1276. if ein2=testpgg.i then
  1277. if exists(coprod.i) then "run >nil: "coprod.i
  1278. end
  1279.  
  1280. /*Vorrausmeldung*/
  1281.  
  1282. if ein2=vmx1gg then do
  1283. ivx=ein3+1
  1284. call topipe2('id 'vmx2gg' s='coxmv.ivx)
  1285. end
  1286. if ein2=vmx2gg then coxmv.ivx=ein3
  1287.  
  1288. if ein2=vmt1gg then do
  1289. ivt=ein3+1
  1290. call topipe2('id 'vmt2gg' s='cotmv.ivt)
  1291. end
  1292. if ein2=vmt2gg then cotmv.ivt=ein3
  1293.  
  1294. if ein2=vmp1gg then do
  1295. ivp=ein3+1
  1296. call topipe2('id 'vmp2gg' s='copmv.ivp)
  1297. end
  1298. if ein2=vmp2gg then copmv.ivp=ein3
  1299. if ein2=spsgg then coprogs=ein3
  1300.  
  1301. /*Sonstige*/
  1302.  
  1303. if ein2=salgg then coablo=ein3
  1304. if ein2=sabgg then do
  1305. covaricyc=ein3
  1306. u=~covaricyc
  1307. if u then cotoncyc=0
  1308. call topipe2('id 'stbgg' ref dis='u)
  1309. end
  1310. if ein2=stbgg then cotoncyc=ein3
  1311. if ein2=smggg then comogra=ein3
  1312.  
  1313. /*Benutzen oder Speichern*/
  1314.  
  1315. if ein2=benugg | ein2=speigg then do
  1316. varicyc=covaricyc ; toncyc=cotoncyc ; ablo=coablo ; mogra=comogra
  1317. progs=coprogs ; expl=coexpl ; expd=coexpd
  1318. gv=coxmv.1 ; vv=coxmv.2 ; kv=coxmv.3 ; fv=coxmv.4 ; dv=coxmv.5
  1319. y=stemcopy('cohgd',1,'hgd',1)
  1320. y=stemcopy('costd',1,'std',1)
  1321. y=stemcopy('cozsb',1,'zsb',1)
  1322. y=stemcopy('cotmv',1,'tmv',1)
  1323. y=stemcopy('copmv',1,'pmv',1)
  1324. y=stemcopy('coont',1,'ont',1)
  1325. y=stemcopy('coonp',1,'onp',1)
  1326. y=stemcopy('cotond',1,'tond',1)
  1327. y=stemcopy('coprod',1,'prod',1)
  1328. do i=1 to 5
  1329. if std.i then hbf.i=""
  1330. else hbf.i='bf="'hgd.i'"'
  1331. end
  1332. if ein2=speigg then do
  1333. call open(9,'Daten/Einstellungen','W')
  1334. do i=1 to hgd.0
  1335. call writeln(9,hgd.i)
  1336. call writeln(9,std.i)
  1337. end
  1338. call writeln(9,1)
  1339. call writeln(9,1)
  1340. do i=1 to zsb.0
  1341. call writeln(9,zsb.i)
  1342. end
  1343. call writeln(9,'-')
  1344. call writeln(9,'-')
  1345. do i=1 to ont.0
  1346. call writeln(9,ont.i tond.i)
  1347. end
  1348. call writeln(9,'-')
  1349. call writeln(9,'-')
  1350. do i=1 to onp.0
  1351. call writeln(9,onp.i prod.i)
  1352. end
  1353. call writeln(9,'-')
  1354. call writeln(9,'-')
  1355. call writeln(9,'-')
  1356. call writeln(9,gv vv kv fv dv)
  1357. savez=tmv.1
  1358. do i=2 to tmv.0
  1359. savez=savez tmv.i
  1360. end
  1361. call writeln(9,savez)
  1362. savez=pmv.1
  1363. do i=2 to pmv.0
  1364. savez=savez pmv.i
  1365. end
  1366. call writeln(9,savez)
  1367. call writeln(9,progs)
  1368. call writeln(9,ablo)
  1369. call writeln(9,varicyc)
  1370. call writeln(9,toncyc)
  1371. call writeln(9,mogra)
  1372. call writeln(9,0)
  1373. call writeln(9,0)
  1374. call writeln(9,0)
  1375. call close(9)
  1376. end
  1377. end
  1378. return
  1379.  
  1380. /*--------- Menü3 -----------*/
  1381.  
  1382. menue3:
  1383. if ein2=0 then
  1384. select
  1385. when ein3=2 then call fensterpos(10,0,0,0)
  1386. when ein3=3 then ein1='close'
  1387. otherwise call fensterpos(10,1,0,ein3)
  1388. end
  1389. return
  1390.  
  1391. /*++++++ Sprechblasenhilfe+++++++ */
  1392.  
  1393. blase:
  1394. bln=arg(1)
  1395. if bln=-1 | symbol('hilfe.bln')='LIT' then bln=0
  1396. if bla=bln then return
  1397. if bla>0 then call topipe('bubble')
  1398. if bln>0 then do
  1399. bly=in3
  1400. blx=in4
  1401. blv=blaverz
  1402. end
  1403. else blv=0
  1404. return
  1405.  
  1406. blase2:
  1407. bln2=arg(1)
  1408. if bln2=-1 | symbol('hilfe2.bln2')='LIT' then bln2=0
  1409. if bla2=bln2 then return
  1410. if bla2>0 then call topipe2('bubble')
  1411. if bln2>0 then do
  1412. bly2=ein3
  1413. blx2=ein4
  1414. blv2=blaverz
  1415. end
  1416. else blv2=0
  1417. return
  1418.  
  1419. /*++++++++++Tonmeldung+++++++++++*/
  1420.  
  1421. tonmeldung:
  1422. do i=1 to 6
  1423. u=i+2
  1424. if varicyc then do
  1425. u2=0
  1426. if i<4 & gz=1 then u2=1
  1427. if i=4 & ez=1 then u2=1
  1428. if i>4 & fz=1 then u2=1
  1429. end
  1430. else u2=1
  1431. if u2 & symbol('tmeld.i')="VAR" & ont.u then do
  1432. call soundplay(tond.u)
  1433. call pause(1)
  1434. end
  1435. end
  1436. return
  1437.  
  1438. /*++++++++++Programmstart+++++++++++*/
  1439.  
  1440. programm:
  1441. do i=1 to 6
  1442. j=i+1
  1443. if onp.j & symbol('pmeld.i')="VAR" then
  1444. if exists(prod.j) & prod.j~="" then
  1445. "run >nil: "prod.j
  1446. end
  1447. return
  1448.  
  1449. /*++++++++++Tonabspielen+++++++++++*/
  1450.  
  1451. soundplay:
  1452. parse arg sout
  1453. call writeln(ca1,'define sound volume 64 fn "'sout'"')
  1454. parse value readln(ca1) with ok nsoundgg
  1455. if ok~='ok' then return
  1456. if soundgg~='' then call topipe('id 'soundgg' freesound')
  1457. soundgg=nsoundgg
  1458. call topipe('id 'soundgg' s 2 volume 64')
  1459. return
  1460.  
  1461. /* ***************** TOPIPE ******************** */
  1462.  
  1463. topipe:
  1464. parse arg out
  1465. call writeln(ca1,out)
  1466. res=readln(ca1)
  1467. parse var res res1 res2 .
  1468. if res1='ok' then return(res2)
  1469. call showtx(0,"TOPIPE-FEHLER","  In Zeile: "sigl"*nZeilentext: "sourceline(sigl)"*nZeilenwert: "out"*n  Rückgabe: "res,1,hbf.4)
  1470. exit
  1471.  
  1472. topipeo:
  1473. parse arg out
  1474. call writeln(ca1,out)
  1475. return readln(ca1)
  1476.  
  1477. topipe2:
  1478. parse arg out
  1479. call writeln(ca2,out)
  1480. res=readln(ca2)
  1481. parse var res res1 res2 .
  1482. if res1='ok' then return(res2)
  1483. call showtx(0,"TOPIPE2-FEHLER","  In Zeile: "sigl"*nZeilentext: "sourceline(sigl)"*nZeilenwert: "out"*n  Rückgabe: "res,1,hbf.4)
  1484. exit
  1485.  
  1486. topipe2o:
  1487. parse arg out
  1488. call writeln(ca2,out)
  1489. return readln(ca2)
  1490.  
  1491. topipe3:
  1492. parse arg out
  1493. call writeln(ca3,out)
  1494. res=readln(ca3)
  1495. parse var res res1 res2 .
  1496. if res1='ok' then return(res2)
  1497. call showtx(0,"TOPIPE3-FEHLER","  In Zeile: "sigl"*nZeilentext: "sourceline(sigl)"*nZeilenwert: "out"*n  Rückgabe: "res,1,hbf.4)
  1498. exit
  1499.  
  1500. topipe4:
  1501. parse arg out
  1502. call writeln(ca4,out)
  1503. res=readln(ca4)
  1504. parse var res res1 res2 .
  1505. if res1='ok' then return(res2)
  1506. call showtx(0,"TOPIPE4-FEHLER","  In Zeile: "sigl"*nZeilentext: "sourceline(sigl)"*nZeilenwert: "out"*n  Rückgabe: "res,1,hbf.4)
  1507. exit
  1508.  
  1509. pause:
  1510. call time('R')
  1511. do while time('E')<arg(1)
  1512. end
  1513. return
  1514.  
  1515. /* Funktion-DATUMD (Ermittelt deutsches Datum) */
  1516. /* Datum = datumd('Z|K|M|N|L|W|D'[,[Systage]|[Tag,Monat,Jahr]]) */
  1517. datumd:
  1518. procedure
  1519. l=arg()
  1520. if l<1 | l=3 | l>4 then return 17
  1521. arg f,t,m,j
  1522. te="Monday Tuesday Wednesday Thursday Friday Saturday Sunday"
  1523. td="Montag Dienstag Mittwoch Donnerstag Freitag Samstag Sonntag"
  1524. me="Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"
  1525. md="Januar Februar März April Mai Juni Juli August September Oktober November Dezember"
  1526. if l=1 then do
  1527.  dn=date('N')
  1528.  ds=date('S')
  1529.  dw=date('W')
  1530.  di=date('I')
  1531. end
  1532. else if l=2 then do
  1533.  dn=date('N',t,'I')
  1534.  ds=date('S',t,'I')
  1535.  dw=date('W',t,'I')
  1536.  di=date('I',t,'I')
  1537. end
  1538. else do
  1539. sd=j||m||t
  1540.  dn=date('N',sd,'S')
  1541.  ds=date('S',sd,'S')
  1542.  dw=date('W',sd,'S')
  1543.  di=date('I',sd,'S')
  1544. end
  1545. select
  1546. when f='Z' then dd=right(ds,2)"."substr(ds,5,2)"."left(ds,4)
  1547. when f='K' then do
  1548. mw=substr(dn,4,3)
  1549. mw=word(md,find(me,mw))
  1550. dd=left(dn,2)". "left(mw,3) right(dn,4)
  1551. end
  1552. when f='M' then do
  1553. mw=substr(dn,4,3)
  1554. mw=word(md,find(me,mw))
  1555. dd=left(word(td,find(te,dw)),2) left(dn,2)". "left(mw,3) right(dn,4)
  1556. end
  1557. when f='N' then do
  1558. mw=substr(dn,4,3)
  1559. mw=word(md,find(me,mw))
  1560. dd=left(dn,2)". "mw right(dn,4)
  1561. end
  1562. when f='W' then dd=word(td,find(te,dw))
  1563. when f='L' then do
  1564. mw=substr(dn,4,3)
  1565. mw=word(md,find(me,mw))
  1566. dd=word(td,find(te,dw))", "left(dn,2)". "mw right(dn,4)
  1567. end
  1568. when f='D' then dd=right(ds,2) substr(ds,5,2) left(ds,4) find(te,dw) di
  1569. otherwise dd=0
  1570. end
  1571. return dd
  1572.  
  1573. /* Funktion-ROUND (Rundet eine Zahl) */
  1574. /* gerundete Zahl = round(Zahl[,Stellen]) */
  1575. round:
  1576. procedure
  1577. if arg()<1 then return 0
  1578. if arg(2,'O')
  1579. then s=0
  1580. else s=arg(2)
  1581. z1=arg(1)
  1582. z2=trunc(z1,s)
  1583. g=z1-z2
  1584. if g>5/(10**(s+1)) then z2=z2+(1/10**s)
  1585. return z2
  1586.  
  1587. /* Funktion MOND */
  1588. /* Mondphase Richtung = mond(Datum,Zeit,Zeitzone) */
  1589. mond:
  1590. procedure
  1591. arg datum,zeit,gmt
  1592. tage=datum-date('I','19850101','S')+1
  1593. parse var zeit std':'min':'sek
  1594. std=std+gmt
  1595. if std>23 then do
  1596. tage=tage+1
  1597. std=std-24
  1598. end
  1599. if std<0 then do
  1600. tage=tage-1
  1601. std=std+24
  1602. end
  1603. tage=tage+((std+(min/60)+(sek/3600))/24)
  1604. phase1=prom(tage)
  1605. phase2=prom(tage+1)
  1606. if phase1<phase2 
  1607. then zun=1
  1608. else zun=0
  1609. RETURN phase1 zun
  1610.  
  1611. /* Phasenberechnung ; Rückgabe = Prozent von Vollmond */
  1612. prom:
  1613. procedure
  1614. arg tage
  1615. ep=279.611371
  1616. rh=282.680403
  1617. se=0.01671542
  1618. lz=18.251907
  1619. pz=192.917585
  1620. nz=55.204723
  1621. n=p360(360*tage/365.24219878)
  1622. ms=p360(n+ep-rh)
  1623. ec=360/pi(1)*se*sin(deg(ms))
  1624. ls=p360(n+ec+ep)
  1625. i=p360(13.1763966*tage+lz)
  1626. mm=p360(i-0.1114041*tage-pz)
  1627. nm=p360(nz-0.0529539*tage)
  1628. ev=1.2739*sin(deg(2*(i-ls)-mm))
  1629. ac=0.1858*sin(deg(ms))
  1630. a3=0.37*sin(deg(ms))
  1631. mmp=mm+ev-ac-a3
  1632. ec=6.2886*sin(deg(mmp))
  1633. a4=0.214*sin(deg(2*mmp))
  1634. ip=i+ev+ec-ac+a4
  1635. v=0.6583*sin(deg(2*(ip-ls)))
  1636. idp=ip+v
  1637. d=idp-ls
  1638. proz=trunc(50*(1-cos(deg(d)))+0.005,2)
  1639. return proz
  1640.  
  1641. p360:
  1642. procedure
  1643. arg dg
  1644. dg=dg//360
  1645. if dg<0 then dg=dg+360
  1646. return dg
  1647.  
  1648. /*(Wochentag eines Datums, auch vor 1978)*/
  1649. wochentag:
  1650. procedure
  1651. parse arg d
  1652. parse var d t'.'m'.'j
  1653. wtd="Mo Di Mi Do Fr Sa So"
  1654. mot="31 28 31 30 31 30 31 31 30 31 30 31"
  1655. gtj=(j-1)*365+(j-1)%4
  1656. gtm=0
  1657. do i=1 to m-1
  1658. gtm=gtm+word(mot,i)
  1659. end
  1660. if j//4=0 & m>2 then gtm=gtm+1
  1661. ges=gtj+gtm+t
  1662. wt=(ges-2)//7+1
  1663. wtt=word(wtd,wt)
  1664. return wtt
  1665.  
  1666. sternzeichen:
  1667. procedure
  1668. parse arg xt,xm
  1669. if xm=01 & xt>19 | xm=02 & xt<19 then stern="Wassermann"
  1670. if xm=02 & xt>18 | xm=03 & xt<21 then stern="Fische"
  1671. if xm=03 & xt>20 | xm=04 & xt<20 then stern="Widder"
  1672. if xm=04 & xt>19 | xm=05 & xt<21 then stern="Stier"
  1673. if xm=05 & xt>20 | xm=06 & xt<22 then stern="Zwilling"
  1674. if xm=06 & xt>21 | xm=07 & xt<23 then stern="Krebs"
  1675. if xm=07 & xt>22 | xm=08 & xt<23 then stern="Löwe"
  1676. if xm=08 & xt>22 | xm=09 & xt<23 then stern="Jungfrau"
  1677. if xm=09 & xt>22 | xm=10 & xt<23 then stern="Waage"
  1678. if xm=10 & xt>22 | xm=11 & xt<22 then stern="Skorpion"
  1679. if xm=11 & xt>21 | xm=12 & xt<22 then stern="Schütze"
  1680. if xm=12 & xt>21 | xm=01 & xt<20 then stern="Steinbock"
  1681. return stern
  1682.  
  1683. /* ****************** HAUPT-GUI ********************* */
  1684.  
  1685. bildegui:
  1686. call open(ca1,"awnpipe:ku1/xc")
  1687. call topipe(' "BEKUNA - 'vers'" cg dg db si sg h state a 'winpos.1' m 'hbf.1)
  1688.  
  1689. fo1=topipe('textattr 'zsb.1)
  1690. fo2=topipe('textattr 'zsb.2)
  1691. fo3=topipe('textattr 'zsb.3)
  1692. fo4=topipe('textattr 'zsb.4)
  1693.  
  1694. call topipe('layout v si so')
  1695.  
  1696. call topipe('layout gt "Begrüßung" font='fo1' v si so')
  1697. call topipe('layout b 0 cj')
  1698. if ~exists('daten/smiley1') then do
  1699. call showtx(1500,"Fehler!","Das Bild «Smiley1» existiert nicht!",1,hbf.4)
  1700. exit
  1701. end
  1702. if ~exists('daten/smiley2') then do
  1703. call showtx(1500,"Fehler!","Das Bild «Smiley2» existiert nicht!",1,hbf.4)
  1704. exit
  1705. end
  1706. if froh then call topipe('bitmap fn="daten/smiley1"')
  1707. else call topipe('bitmap fn="daten/smiley2"')
  1708. smilgg=topipe('button b 4 ro ui weiw=0 weih=0')
  1709. if froh then hilfe.smilgg="Ich bin fröhlich!"
  1710. else hilfe.smilgg="Ich bin traurig!"
  1711. begrgg=topipe('button gt "'beg'" ro')
  1712. hilfe.begrgg="Hallo "ename", mit diesem Feld Begrüße ich Dich!"
  1713. call topipe('le')
  1714. if symbol('beg1')="VAR" then call topipe('button gt "'beg1'" ro')
  1715. if symbol('beg2')="VAR" then call topipe('button gt "'beg2'" ro')
  1716. call topipe('le')
  1717.  
  1718. nrw="1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20"
  1719. call topipe('layout gt "Ereignisse" font='fo2' v si so')
  1720. if gz=0 & ez=0 & fz=0 then meld1=keine
  1721. if meli1.0=0 & meli2.0=0 & meli3.0=0 then meld1=keined
  1722.  
  1723. if gz>0 then do
  1724. call topipe('layout b 0')
  1725. call topipe('button b 8 gt "G" ro weiw=0')
  1726. gzgg=topipe('button gt "'geb.1'" ro')
  1727. hilfe.gzgg="In diesem Feld Melde ich Dir*nGeburtstage und vergangene Ereignisse."
  1728. if gz>1 then do
  1729. if gz>20 then gz=20
  1730. cl=space(subword(nrw,1,gz),1,'|')
  1731. gcgg=topipe('chooser cl "'cl'" maxn=20 pu weiw=0')
  1732. hilfe.gcgg="Hier kannst Du die*nMeldungen durchblättern.*nBeim Betätigen wird das*nautomatische Blättern abgeschaltet."
  1733. end
  1734. call topipe('le')
  1735. end
  1736.  
  1737. if ez>0 then do
  1738. call topipe('layout b 0')
  1739. call topipe('button b 8 gt "E" ro weiw=0')
  1740. ezgg=topipe('button gt "'ereig.1'" ro')
  1741. hilfe.ezgg="In diesem Feld Melde ich Dir*nkommende Ereignisse."
  1742. if ez>1 then do
  1743. if ez>20 then ez=20
  1744. cl=space(subword(nrw,1,ez),1,'|')
  1745. ecgg=topipe('chooser cl "'cl'" maxn=20 pu weiw=0')
  1746. hilfe.ecgg="Hier kannst Du die*nMeldungen durchblättern.*nBeim Betätigen wird das*nautomatische Blättern abgeschaltet."
  1747. end
  1748. call topipe('le')
  1749. end
  1750.  
  1751. if fz>0 then do
  1752. call topipe('layout b 0')
  1753. call topipe('button b 8 gt "F" ro weiw=0')
  1754. fzgg=topipe('button gt "'feier.1'" ro')
  1755. hilfe.fzgg="In diesem Feld Melde ich Dir*nFeier-, Fest-*nund Gedenktage."
  1756. if fz>1 then do
  1757. if fz>20 then fz=20
  1758. cl=space(subword(nrw,1,fz),1,'|')
  1759. fcgg=topipe('chooser cl "'cl'" maxn=20 pu weiw=0')
  1760. hilfe.fcgg="Hier kannst Du die*nMeldungen durchblättern.*nBeim Betätigen wird das*nautomatische Blättern abgeschaltet."
  1761. end
  1762. call topipe('le')
  1763. end
  1764.  
  1765. if symbol('meld1')="VAR" then call topipe('button gt "'meld1'" ro')
  1766. if symbol('meld2')="VAR" then call topipe('button gt "'meld2'" ro')
  1767. if symbol('meld3')="VAR" then call topipe('button gt "'meld3'" ro')
  1768. if symbol('meld4')="VAR" then call topipe('button gt "'meld4'" ro')
  1769. call topipe('le')
  1770.  
  1771. call topipe('layout gt "Datum/Zeit" font='fo3' si so cj weih=0')
  1772. call topipe('space')
  1773. call topipe('label gt "Heute ist" ss=2 ua')
  1774. call topipe('button gt "'dat'" ro weiw=0 chl')
  1775. call topipe('space')
  1776. call topipe('label gt "Es ist jetzt" ss=2 ua')
  1777. call topipe('layout b 0 si weiw=0 weih=0 chl')
  1778. zeigg=topipe('button gt "'zei' Uhr" ro weiw=0')
  1779. call topipe('button gt "'som'" ro weiw=0')
  1780. call topipe('le')
  1781. call topipe('space')
  1782. call topipe('le')
  1783.  
  1784. call topipe('layout gt "Mond/Sterne" font='fo3' si so cj weih=0')
  1785. call topipe('space')
  1786. call topipe('label gt "Mond:" ss=2 ua')
  1787. if ~exists(mogdz) | ~exists(mogda) then do
  1788. call showtx(500,"Fehler!","Die Mondgrafik existiert nicht!",1,hbf.4)
  1789. mogra=0
  1790. end
  1791. if mogra then do
  1792. mopg=round(((brate-1)/100)*mop,0)
  1793. if ~exists(mogdz) | ~exists(mogda) then do
  1794. call showtx(500,"Fehler!","Die Mondgrafik existiert nicht!",1,hbf.4)
  1795. mogra=0
  1796. end
  1797. if mori then do
  1798. mobi=mopg*mogrb
  1799. call topipe('button fn "'mogdz'" ro weiw=0 weih=0 chl anim="'mobi'|0|'mogrb'|'mogrh'|0|0|0"')
  1800. end
  1801. else do
  1802. mobi=((brate-1)-mopg)*mogrb
  1803. call topipe('button fn "'mogda'" ro weiw=0 weih=0 chl anim="'mobi'|0|'mogrb'|'mogrh'|0|0|0"')
  1804. end
  1805. call topipe('button gt "'mop'%" ro weih=0 weiw=0')
  1806. call topipe('button gt "'zuab'" ro weih=0 weiw=0')
  1807. end
  1808. else do
  1809. call topipe('fuelgauge ticks=5 defn='mop' per minw=150 chl')
  1810. call topipe('button gt "'zuab'" ro weih=0')
  1811. end
  1812. call topipe('space')
  1813. call topipe('label gt "Sternbild:" ss=2 ua')
  1814. call topipe('button gt "'stern'" ro weih=0 chl')
  1815. call topipe('space')
  1816. call topipe('le')
  1817.  
  1818. call topipe('layout b 0 font='fo4' si so weih=0')
  1819. call topipe('layout b 0 si weiw=0 weih=0')
  1820. swkgg=topipe('button gt "_K" weiw=0')
  1821. hilfe.swkgg="Zeigt den Kalender."
  1822. swfgg=topipe('button gt "_F" weiw=0')
  1823. hilfe.swfgg="Zeigt die Feiertagsliste*nvon diesem Jahr ("xj")."
  1824. call topipe('le')
  1825. call topipe('layout b 0 si weiw=0 weih=0')
  1826. okgg=topipe('button gt " _Hab''s  verstanden " c weiw=0')
  1827. hilfe.okgg='Hast Du alles Verstanden?*nDann klicke hier und*nBekuna wird beendet.'
  1828. call topipe('le')
  1829. call topipe('layout b 0 si weiw=0 weih=0')
  1830. swagg=topipe('button gt "_A" weiw=0')
  1831. hilfe.swagg="Anzeige der kommenden Ereignisse."
  1832. swegg=topipe('button gt "_E" weiw=0')
  1833. hilfe.swegg="Eingabe von kommenden Ereignissen."
  1834. call topipe('le')
  1835. call topipe('le')
  1836.  
  1837. call topipe('le')
  1838.  
  1839. /*Menüs Erstellen*/
  1840. me0=topipe('menu gt "Projekt|@LVorletzter Systemstart|@PEinstellungen|Fensterposition fixieren|Fensterposition freigeben|-|Über|@QBeenden"')
  1841. me1=topipe('menu gt "Daten anzeigen|@FFeiertage 'xj'|Feiertage 'xj+1'|@GGeburtstage|@VVergangene Ereignisse|@KKommende Ereignisse|@WWiederkehrende Ereignisse"')
  1842. me2=topipe('menu gt "Daten eingeben|Geburtstage|Vergangene Ereignisse|@EKommende Ereignisse|Wiederkehrende Ereignisse"')
  1843.  
  1844. call topipe('arexx gt "BEKUNA|front|quit"')
  1845. call topipe("open")
  1846. return
  1847.  
  1848. /* ****************** DATENEINGABE-GUI ********************* */
  1849.  
  1850. bildegui2:
  1851. call open(ca2,"awnpipe:ku2/xc")
  1852. efpos=arg(5)
  1853. parse value arg(2) with feld1'|'feld2'|'feld3'|'feld4
  1854. call topipe2(' "Dateneingabe" cg dg db si sg a nowindow 'winpos.efpos' m 'hbf.3)
  1855. fo5=topipe2('textattr 'zsb.5)
  1856. call topipe2('layout v si so')
  1857. call topipe2('layout gt "'arg(1)'" v si so')
  1858. bgg=topipe2('listbrowser lbl="'arg(2)'" font='fo5' v a st minh=80')
  1859. call topipe2('layout b 0 si weih=0')
  1860. ngg=topipe2('button gt "_Hinzufügen" weiw=0')
  1861. lgg=topipe2('button gt "_Entfernen" dis 1 weiw=0')
  1862. call topipe2('le')
  1863. call topipe2('button b=7 minh=2 weih=2')
  1864. call topipe2('label gt "'feld1':" ua')
  1865. vngg=topipe2('string chl lj dis 1')
  1866. call topipe2('label gt "'feld2':" ua')
  1867. if efpos>3 then do
  1868. call topipe2('layout chl bj b=0 weih=0')
  1869. dagg=topipe2('string lj dis 1')
  1870. kalgg=topipe2('button gt "K" dis 1 weiw=0')
  1871. call topipe2('le')
  1872. end
  1873. else dagg=topipe2('string chl lj dis 1 weih=0')
  1874. if efpos=11 then do
  1875. call topipe2('label gt "'feld3':" ua')
  1876. call topipe2('layout chl bj b=0 weih=0')
  1877. da2gg=topipe2('string lj dis 1')
  1878. kal2gg=topipe2('button gt "K" dis 1 weiw=0')
  1879. call topipe2('le')
  1880. call topipe2('label gt "'feld4':" ua')
  1881. intgg=topipe2('chooser cl "Ausgeschaltet|Jeder 2. Tag|Jeder 3. Tag|Jeder 4. Tag|Jeder 5. Tag|Jeder 6. Tag|Jede Woche|Jede 2. Woche|Jede 3. Woche|Jede 4. Woche|Jeden Monat|Jeder 2. Monat|Jeder 3. Monat|Jeder 6. Monat|Jedes Jahr" pu maxn 15 chl dis 1 s=6 weih=0')
  1882. end
  1883. call topipe2('le')
  1884. call topipe2('layout b 0 si weih=0')
  1885. spgg=topipe2('button gt "_Speichern" c weiw=0')
  1886. abgg=topipe2('button gt "_Abbrechen" c weiw=0')
  1887. call topipe2('le')
  1888. call topipe2('le')
  1889. me0=topipe2('menu gt "Fenster|@GGröße fixieren|@PGröße & Position fixieren|@FFreigeben|@QSchließen"')
  1890. offgg=topipe2("open")
  1891. z=0
  1892. do i=1 to arg(4)
  1893. a=value(arg(3)".i")
  1894. if ~(aw=2 & symbol('lzle.i')='VAR') then do
  1895. z=z+1
  1896. li.z=a
  1897. call topipe2('id 'bgg' gt "'a'" tar=-1 addn')
  1898. end
  1899. end
  1900. li.0=z
  1901. call topipe2('id 0 s 64')
  1902. return
  1903.  
  1904. /* ****************** EINSTELL-GUI ********************* */
  1905.  
  1906. bildegui3:
  1907. call open(ca2,"awnpipe:ku2/xc")
  1908. call topipe2(' "Einstellungen" cg dg db h state si sg a 'winpos.10' m 'hbf.5)
  1909.  
  1910. call topipe2('layout v si so')
  1911. pagegg=topipe2('clicktab ctl "Hintergrund|Zeichensatz|Tonmeldung|Programmstart|Verschiedenes"')
  1912.  
  1913. /*Hintergrund*/
  1914. call topipe2('layout b=0 v si so page='pagegg)
  1915. call topipe2('layout gt "Hintergrund" v si so')
  1916. ltx.1="Programmfenster"
  1917. ltx.2="Datenanzeigefenster"
  1918. ltx.3="Dateneingabefenster"
  1919. ltx.4="Meldungsfenster"
  1920. ltx.5="Dieses & Kalender"
  1921. do i=1 to 5
  1922. call topipe2('label gt "'ltx.i'" ss=2 ua')
  1923. call topipe2('layout b 0 si so cj chl')
  1924. hdgg.i=topipe2('getfile gt="Wähle ein Hintergrundmuster" fn="'hgd.i'" i minw=250 dis='std.i)
  1925. ggn=hdgg.i
  1926. hilfe2.ggn="Dateiauswahl für Hintergrundmuster"
  1927. hsgg.i=topipe2('checkbox gt "Standard" rj s='std.i)
  1928. ggn=hsgg.i
  1929. hilfe2.ggn="Bei Aktivierung, wird das*nStandard-Hintergrundmuster*nverwendet."
  1930. call topipe2('bitmap fn="'hgd.i'" part="0|0|'bigro'|'bigro'|0|0|0"')
  1931. hbgg.i=topipe2('button ro ui dis='std.i)
  1932. ggn=hbgg.i
  1933. hilfe2.ggn="Muster-Vorschau"
  1934. call topipe2('le')
  1935. end
  1936. call topipe2('le')
  1937. call topipe2('le')
  1938.  
  1939. /*Fonts*/
  1940. call topipe2('layout b=0 v si so page='pagegg)
  1941. call topipe2('layout gt "Fonts" v si so weih=0')
  1942. ltx.1="Begrüßungsfeld"
  1943. ltx.2="Ereignisfelder"
  1944. ltx.3="Datum/Zeit/Mond/Sterne"
  1945. ltx.4="Knöpfe im Hauptfenster"
  1946. ltx.5="Liste im Eingabefenster"
  1947. ltx.6="Liste im Ausgabefenster"
  1948. do i=1 to 6
  1949. call topipe2('label gt "'ltx.i':" ss=2 ua')
  1950. call topipe2('layout b 0 si weih=0 chl')
  1951. zsgg.i=topipe2('getfont style minn=8 maxn=24 high=250 chl')
  1952. ggn=zsgg.i
  1953. hilfe2.ggn="Zeichensatz-Auswahl"
  1954. parse var zsb.i . '"' a '"' . '=' b ' s=' c
  1955. af.i=a||'/'||b
  1956. ggn=topipe2('button gt "'af.i'" ro')
  1957. hilfe2.ggn="Zeigt den bereits*nbenutzten Zeichensatz."
  1958. call topipe2('le')
  1959. end
  1960. call topipe2('le')
  1961. call topipe2('le')
  1962.  
  1963. /*Sound*/
  1964. call topipe2('layout b=0 v si so page='pagegg)
  1965. call topipe2('layout gt "Sound" v si so weih=0')
  1966. ltx.1="Beim Öffnen"
  1967. ltx.2="Beim Schließen"
  1968. ltx.3="Eigener Geburtstag"
  1969. ltx.4="Anderer Geburtstag"
  1970. ltx.5="Vergangenes Ereignis"
  1971. ltx.6="Kommendes Ereignis"
  1972. ltx.7="Gesetzlicher Feiertag"
  1973. ltx.8="Sonstiger Feiertag"
  1974. do i=1 to 8
  1975. call topipe2('label gt "'ltx.i':" ss=2 ua')
  1976. call topipe2('layout b 0 weih=0 chl')
  1977. ontgg.i=topipe2('checkbox weiw=0 s='ont.i)
  1978. ggn=ontgg.i
  1979. hilfe2.ggn="Damit kann die Tonmeldung für ein Ereignis,*nEin- oder Ausgeschaltet werden."
  1980. u=~ont.i
  1981. sougg.i=topipe2('getfile fn="'tond.i'" dis='u)
  1982. ggn=sougg.i
  1983. hilfe2.ggn="Sounddatei-Auswahl"
  1984. testtgg.i=topipe2('button gt "Test" weiw=0 dis='u)
  1985. ggn=testtgg.i
  1986. hilfe2.ggn="Spielt den gewählten Sound ab."
  1987. call topipe2('le')
  1988. end
  1989. call topipe2('le')
  1990. call topipe2('le')
  1991.  
  1992. /*Programmstart*/
  1993. call topipe2('layout b=0 v si so page='pagegg)
  1994. call topipe2('layout gt "Programmstart" v si so weih=0')
  1995. ltx.1="Immer beim Schließen"
  1996. ltx.2="Eigener Geburtstag"
  1997. ltx.3="Anderer Geburtstag"
  1998. ltx.4="Vergangenes Ereignis"
  1999. ltx.5="Kommendes Ereignis"
  2000. ltx.6="Gesetzlicher Feiertag"
  2001. ltx.7="Sonstiger Feiertag"
  2002. do i=1 to 7
  2003. call topipe2('label gt "'ltx.i':" ss=2 ua')
  2004. call topipe2('layout b 0 weih=0 chl')
  2005. onpgg.i=topipe2('checkbox weiw=0 s='onp.i)
  2006. ggn=onpgg.i
  2007. hilfe2.ggn="Damit kann der Programmstart für ein Ereignis,*nEin- oder Ausgeschaltet werden."
  2008. u=~onp.i
  2009. startgg.i=topipe2('getfile fn="'prod.i'" dis='u)
  2010. ggn=startgg.i
  2011. hilfe2.ggn="Programm-Auswahl"
  2012. testpgg.i=topipe2('button gt "Test" weiw=0 dis='u)
  2013. ggn=testpgg.i
  2014. hilfe2.ggn="Startet das gewählte Programm."
  2015. call topipe2('le')
  2016. end
  2017. call topipe2('le')
  2018. call topipe2('le')
  2019.  
  2020. /*Sonstiges*/
  2021. call topipe2('layout b=0 v si so page='pagegg)
  2022. call topipe2('layout gt "Vorrausmeldungen" v si so weih=0')
  2023.  
  2024. call topipe2('label gt "Textmeldung im Vorraus:" ua')
  2025. call topipe2('layout b 0 si so chl weih=0')
  2026. vmx1gg=topipe2('chooser cl "Geburtstage|Vergangene Ereignisse|Kommende Ereignisse|Gesetzliche Feiertage|Sonstige Feiertage" pu')
  2027. hilfe2.vmx1gg="Ereignis-Auswahl*nfür Textmeldungen."
  2028. vmx2gg=topipe2('chooser cl "Nicht im Vorraus|1 Tag|2 Tage|3 Tage|4 Tage|5 Tage|6 Tage|1 Woche|2 Wochen|3 Wochen|1 Monat|2 Monate|3 Monate|6 Monate|1 Jahr" pu maxn=15 chl s='gv)
  2029. hilfe2.vmx2gg="Wähle hier den*nVorrausmeldezeitraum*nfür Textmeldungen."
  2030. call topipe2('le')
  2031.  
  2032. call topipe2('label gt "Tonmeldung im Vorraus:" ua')
  2033. call topipe2('layout b 0 si so chl weih=0')
  2034. vmt1gg=topipe2('chooser cl "Eigener Geburtstag|Anderer Geburtstag|Vergangenes Ereignis|Kommendes Ereignis|Gesetzlicher Feiertag|Sonstiger Feiertag" pu')
  2035. hilfe2.vmt1gg="Ereignis-Auswahl*nfür Tonmeldungen."
  2036. vmt2gg=topipe2('chooser cl "Nicht im Vorraus|Wie Textmeldung|1 Tag|2 Tage|3 Tage|4 Tage|5 Tage|6 Tage|1 Woche|2 Wochen|3 Wochen|1 Monat" pu chl s='tmv.1)
  2037. hilfe2.vmt2gg="Wähle hier den*nVorrausmeldezeitraum*nfür Tonmeldungen."
  2038. call topipe2('le')
  2039.  
  2040. call topipe2('label gt "Programmstart im Vorraus:" ua')
  2041. call topipe2('layout b 0 si so chl weih=0')
  2042. vmp1gg=topipe2('chooser cl "Eigener Geburtstag|Anderer Geburtstag|Vergangenes Ereignis|Kommendes Ereignis|Gesetzlicher Feiertag|Sonstiger Feiertag" pu')
  2043. hilfe2.vmp1gg="Ereignis-Auswahl*nfür Programmstart."
  2044. vmp2gg=topipe2('chooser cl "Nicht im Vorraus|1 Tag|2 Tage|3 Tage|4 Tage|5 Tage|6 Tage|7 Tage|8 Tage|9 Tage|10 Tage|11 Tage|12 Tage|13 Tage|14 Tage" pu chl maxn=15 s='pmv.1)
  2045. hilfe2.vmp2gg="Wähle hier, wie weit*nim Vorraus ein Programm*ngestartet werden soll."
  2046. call topipe2('le')
  2047. spsgg=topipe2('checkbox gt "Programmstart nur am eingestellten Tag" weiw=0 s='progs)
  2048. hilfe2.spsgg="Wähle hier, ob ein*nProgrammstart, nur am*neingestellten *noder jeden Tag,*nim Vorraus erfolgen soll."
  2049. call topipe2('le')
  2050.  
  2051. call topipe2('layout gt "Sonstiges" v si so weih=0')
  2052. salgg=topipe2('checkbox gt "Abgelaufene, kommende Ereignisse löschen" rj s='ablo)
  2053. hilfe2.salgg="Wähle hier, ob abgelaufene,*nkommende Ereignisse*ngelöscht werden sollen."
  2054. sabgg=topipe2('checkbox gt "Automatisch blättern" rj s='varicyc)
  2055. hilfe2.sabgg="Wenn mehrere Meldungen*nin einer Gruppe auftreten,*nkönnen diese automatisch*ndurchgeblättert werden."
  2056. u=~varicyc
  2057. stbgg=topipe2('checkbox gt "Tonmeldungen blättern" rj s='variton' dis='u)
  2058. hilfe2.stbgg="Beim automatischen Durchblättern,*nkann auch zu jeder Textmeldung*nein Sound abgespielt werden."
  2059. smggg=topipe2('checkbox gt "Mondgrafik benutzen" rj s='mogra)
  2060. hilfe2.smggg="Damit kann statt*nder Balkenanzeige,*neine Mondgrafik*nbenutzt werden."
  2061. call topipe2('le')
  2062. call topipe2('space')
  2063. call topipe2('le')
  2064.  
  2065. call topipe2('layout b 7 si so weih=0')
  2066. speigg=topipe2('button gt "_Speichern" c weiw=0')
  2067. benugg=topipe2('button gt "_Benutzen" c weiw=0')
  2068. call topipe2('button gt "_Abbrechen" c weiw=0')
  2069. call topipe2('le')
  2070. call topipe2('le')
  2071.  
  2072. me0=topipe2('menu gt "Fenster|@GGröße fixieren|@PGröße & Position fixieren|@FFreigeben|@QSchließen"')
  2073. call topipe2("open")
  2074. return
  2075.  
  2076. /*--------Datenliste-----------*/
  2077.  
  2078. listanz:
  2079. /*(Titel,Spaltentitel,Stemvar,Position,Nr,Hintergr)*/
  2080. afpos=arg(5)+5
  2081. call open(ca2,'awnpipe:ku2/xc')
  2082. call topipe2(' "Liste" defg 'arg(4)' m a nowindow so si 'arg(6))
  2083. fo6=topipe2('textattr 'zsb.6)
  2084. call topipe2('layout gt "'arg(1)'" si so minw=200 minh=200')
  2085. bdlgg=topipe2('listbrowser lbl="'arg(2)'" font='fo6' v a st')
  2086. call topipe2('le')
  2087. me0=topipe2('menu gt "Fenster|@GGröße fixieren|@PGröße & Position fixieren|@FFreigeben|@QSchließen"')
  2088. call topipe2('open')
  2089. do i=1 to value(arg(3)".0")
  2090. call topipe2('id 'bdlgg' gt "'value(arg(3)".i")'" tar=-1 addn')
  2091. end
  2092. call topipe2('id 0 s 64')
  2093. if show('P','SHOWTX') then address 'SHOWTX' 'quit'
  2094. do while ~eof(ca2)
  2095. call topipe2('con')
  2096. ein=readln(ca2)
  2097. parse var ein ein1 ein2 ein3 .
  2098. if ein1='menu' & ein2=0 then
  2099. select
  2100. when ein3=2 then call fensterpos(afpos,0,0,0)
  2101. when ein3=3 then ein1='close'
  2102. otherwise call fensterpos(afpos,1,0,ein3)
  2103. end
  2104. if ein1='close' then leave
  2105. end
  2106. call close(ca2)
  2107. return
  2108.  
  2109. /* --------KALENDER-GUI ---------- */
  2110.  
  2111. kalender:
  2112. if arg(2,'E') then do
  2113. kaldat=arg(2)
  2114. parse var kaldat kt'.'km'.'kj .
  2115. wtn1=word(datumd('D',01,km,kj),4)
  2116. end
  2117. else do
  2118. kaldat=datumd('Z')
  2119. parse var kaldat kt'.'km'.'kj .
  2120. wtn1=word(datumd('D',01,km,kj),4)
  2121. end
  2122. tage=word("31 28 31 30 31 30 31 31 30 31 30 31",km)
  2123. if km=2 then if kj//4=0 then tage=29
  2124. call open(ca3,"awnpipe:ku3/xc")
  2125. call topipe3(' "Kalender" defg si a cm m 'arg(5))
  2126. call topipe3('layout v si so')
  2127. call topipe3('layout b 0 si so')
  2128. jggk=topipe3('integer a minc 4 maxc 5 minn 1978 maxn 2099 defn 'kj' weiw 0')
  2129. mggk=topipe3('chooser cl "Januar|Februar|März|April|Mai|Juni|Juli|August|September|Oktober|November|Dezember" s 'km-1' pu weiw 0')
  2130. call topipe3('le')
  2131. call topipe3('layout b 0 si so')
  2132. do i=1 to 7
  2133. wtk=word("Mo Di Mi Do Fr Sa So",i)
  2134. call topipe3('button gt "'wtk'" ro')
  2135. end
  2136. call topipe3('le')
  2137. z1=0 ; z2=0
  2138. do j=1 to 6
  2139. call topipe3('layout b 0 si so')
  2140. do i=1 to 7
  2141. z2=z2+1
  2142. if i<wtn1 & j=1 | z1>=tage then tggk.z2=topipe3('button gt " " dis 1')
  2143. else do
  2144. z1=z1+1
  2145. if z1=1 then diff=z2-1
  2146. if kt=z1 then z3="ro s=1"
  2147. else z3=""
  2148. tggk.z2=topipe3('button gt "'z1'" pb 'z3)
  2149. end
  2150. end
  2151. call topipe3('le')
  2152. end
  2153. call topipe3('le')
  2154. call topipe3('open')
  2155.  
  2156. do while ~eof(ca3)
  2157. call topipe3('continue')
  2158. kin=readln(ca3)
  2159. parse var kin kin1 kin2 kin3 .
  2160. if kin1='gadget' then call objektk(arg(1),arg(3),arg(4))
  2161. if kin1='close' then leave
  2162. end
  2163. call close(ca3)
  2164. return kaldat
  2165.  
  2166. /*---ObjektK---*/
  2167.  
  2168. objektk:
  2169. /*Tagwahl*/
  2170. do i=1+diff to tage+diff
  2171. if kin2=tggk.i then do
  2172. ta=kt+diff
  2173. kt=right("0"i-diff,2)
  2174. call topipe3('id 'tggk.ta' s=0 ro=0')
  2175. call topipe3('id 'tggk.i' s=1 ro=1')
  2176. end
  2177. end
  2178. /*Monatswahl*/
  2179. if kin2=mggk then do
  2180. km=right("0"kin3+1,2)
  2181. call aktukal()
  2182. end
  2183. /*Jahreswahl*/
  2184. if kin2=jggk then do
  2185. kj=kin3
  2186. call aktukal()
  2187. end
  2188. if arg(1) then do
  2189. kaldat=kt'.'km'.'kj
  2190. call writeln(arg(2),'id 'arg(3)' gt "'kaldat'" ref')
  2191. y=readln(arg(2))
  2192. end
  2193. return
  2194.  
  2195. aktukal:
  2196. ta=kt+diff
  2197. call topipe3('id 'tggk.ta' s=0 ro=0')
  2198. wtn1=word(datumd('D',01,km,kj),4)
  2199. tage=word("31 28 31 30 31 30 31 31 30 31 30 31",km)
  2200. if km=2 then if kj//4=0 then tage=29
  2201. if kt>tage then kt=tage
  2202. z1=0 ; z2=0
  2203. do j=1 to 6
  2204. do i=1 to 7
  2205. z2=z2+1
  2206. if i<wtn1 & j=1 | z1>=tage then call topipe3('id 'tggk.z2' gt " " ref dis 1')
  2207. else do
  2208. z1=z1+1
  2209. if z1=1 then diff=z2-1
  2210. if kt=z1 then z3="ro=1 s=1" 
  2211. else z3=""
  2212. call topipe3('id 'tggk.z2' gt "'z1'" ref dis 0 'z3)
  2213. end
  2214. end
  2215. end
  2216. return
  2217.  
  2218. /* --------- FEHLER ----------- */
  2219.  
  2220. syntax:
  2221. call errord(rc,sigl,sourceline(sigl),hbf.4)
  2222. exit
  2223.  
  2224. break_e:
  2225. call showtx(1000,"Abbruch","Das Programm wurde mit Ctrl-E unterbrochen!",1,hbf.4)
  2226. exit
  2227.  
  2228. halt:
  2229. call showtx(1000,"HALT","Das Programm hat einen HALT-Befehl empfangen!",1,hbf.4)
  2230. exit
  2231.  
  2232. error:
  2233. call showtx(1000,"FEHLER","Ein Externer Befehl hat einen Fehler gemeldet!",1,hbf.4)
  2234. exit
  2235.  
  2236. ioerr:
  2237. call showtx(1000,"FEHLER","Ein- Ausgabe- Fehler!",1,hbf.4)
  2238. exit
  2239.